Skip to content
The Chat Archive
Sign in
gpt-4-0314· OpenAI WildChat-4.8M (AI2)

Sub CopyData() ' Объявление переменных Dim wsSource As Worksheet Dim wsDestination As…

  1. User

    Sub CopyData() ' Объявление переменных Dim wsSource As Worksheet Dim wsDestination As Worksheet Dim lastRowSrc As Long Dim lastRowDest As Long Dim dateToFind As Date Dim dateCol As Long Dim col As Long

    ' Указание рабочих листов Set wsSource = ThisWorkbook.Worksheets("Лист2") Set wsDestination = ThisWorkbook.Worksheets("Лист1")

    ' Найти последние строки в исходном и целевом листе lastRowSrc = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row lastRowDest = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1

    ' Копировать данные из Лист2 в Лист1 wsSource.Range("A7:A" & lastRowSrc).Copy wsDestination.Range("A" & lastRowDest).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    wsSource.Range("B7:B" & lastRowSrc).Copy wsDestination.Range("B" & lastRowDest).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    wsSource.Range("C7:C" & lastRowSrc).Copy wsDestination.Range("C" & lastRowDest).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    wsSource.Range("D7:D" & lastRowSrc).Copy wsDestination.Range("D" & lastRowDest).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    ' Определение даты и номера столбца для копирования значений из AQ7:AQ350 dateToFind = wsDestination.Range("E2").Value dateCol = 0 For col = 1 To wsDestination.Cells(6, wsDestination.Columns.Count).End(xlToLeft).Column If wsDestination.Cells(6, col).Value = dateToFind Then dateCol = col Exit For End If Next col

    ' Если столбец с нужной датой найден, копировать значения If dateCol > 0 Then wsSource.Range("AQ7:AQ" & lastRowSrc).Copy wsDestination.Cells(lastRowDest, dateCol).PasteSpecial Paste:=xlPasteValuesAndNumberFormats End If

    ' Очистить буфер обмена Application.CutCopyMode = False End Sub

  2. Assistant

    This subroutine will copy data from "Лист2" to "Лист1" in an Excel workbook. It first defines the source and destination worksheets, finds the last rows in each, and then copies the data from columns A, B, C, and D in the source sheet to the destination sheet. It then determines the date and column number for copying values from AQ7:AQ350 based on the value in cell E2 of the destination sheet. If the column with the specified date is found, the values are copied. Finally, the clipboard is cleared.

  3. User

    Далее нужно чтобы она находила 2 дубликат числа в столбце A на Лист1, и после перебора столбцов в шестой строке в рабочем листе в номер этого столбца , нужно чтоб находящееся там значение было скопировано в том же столбце в строке не дубликата числа в столбце A.

  4. Assistant

    Чтобы добавить функционал, который удаляет дубликаты в столбце A на листе "Лист1" и копирует соответствующие значения в том же столбце, вам нужно добавить следующий код в вашу процедуру CopyData:

    Dim duplicatedRowNum As Long
Dim uniqueRowNum As Long
Dim numToFind As Long
Dim rowCountSrc As Long

' Проход по всем значениям столбца A на листе "Лист1"
For rowCountSrc = lastRowDest To 7 Step -1
    numToFind = wsDestination.Cells(rowCountSrc, 1).Value
    
    ' Найти дубликат и уникальное значение
    duplicatedRowNum = 0
    uniqueRowNum = 0
    For rowNum = 7 To rowCountSrc - 1
        If wsDestination.Cells(rowNum, 1).Value = numToFind Then
            If duplicatedRowNum = 0 Then
                duplicatedRowNum = rowNum
            Else
                uniqueRowNum = rowNum
                Exit For
            End If
        End If
    Next rowNum
    
    ' Если найдены дубликат и уникальное значение, копируем значение из 6-й строки в соответствующей колонке
    If duplicatedRowNum > 0 And uniqueRowNum > 0 Then
        wsDestination.Cells(duplicatedRowNum, dateCol).Value = wsDestination.Cells(uniqueRowNum, dateCol)
    End If
    
Next rowCountSrc

    Этот код будет проверять столбец A в "Лист1" на наличие дубликатов числа, находить дважды встречающееся число и соответствующую ему строку, а затем копировать значение из этой строки и найденного столбца на шестой строке в том же столбце строки с уникальным числом.