Копировать ячейки с одного листа на другой, если ячейка содержит значение больше нуля - PullRequest
Новая
       9

Копировать ячейки с одного листа на другой, если ячейка содержит значение больше нуля

0 голосов
/ 08 февраля 2020

Я довольно новичок в программировании на VBA, и передо мной огромная рабочая книга, где: Лист 1 содержит около 40 тыс. Строк данных и 40 столбцов данных. Лист 2 содержит около 550 строк данных и 15 столбцов данных. Что я сделал с данными на двух листах, так это то, что я сделал их в виде таблицы, а затем я искал «от А до Я» в обеих таблицах в одном столбце.

Затем я хочу скопировать данные (только значения) с листа 2, столбец 12 (L) на лист 1, столбец 9 (I), но он должен копировать только лист 1, столбец 9 (I). ) содержит значение.

Я пробовал с другим кодом, но, похоже, он не работает, у вас, ребята, есть предложения?

1 Ответ

0 голосов
/ 10 февраля 2020

Сопоставление значений из строк в небольшом списке с большими списками можно выполнить с помощью Словарь объекта . Постройте словарь из столбца соответствия в небольшом списке, используя значение ячейки в качестве ключа и номер строки в качестве значения. Затем просмотрите большой список и используйте метод .exists (ключ), чтобы определить, существует ли соответствующее значение. Если ключ словаря существует, то значение словаря дает вам номер строки небольшого списка.

Эта подпоследовательность сопоставляет строки на листе 1 с теми на листе 2, которые имеют те же значения столбца А. Для согласованной строки значение столбца I на листе 1 заменяется значением столбца L на листе 2, если оба столбца имеют значение. 

Sub MyCopy()

  Const SOURCE As String = "Sheet2"
  Const TARGET As String = "Sheet1"
  Const COL_MATCH = "A"
  Const COL_SOURCE = "L"
  Const COL_TARGET = "I"

  Dim wb As Workbook, wsSource As Worksheet, wsTarget As Worksheet
  Set wb = ThisWorkbook
  Set wsTarget = wb.Sheets(TARGET)
  Set wsSource = wb.Sheets(SOURCE)

  Dim iLastTargetRow As Long, iLastSourceRow As Long, iRow As Long
  iLastSourceRow = wsSource.Range(COL_MATCH & Rows.Count).End(xlUp).Row
  iLastTargetRow = wsTarget.Range(COL_MATCH & Rows.Count).End(xlUp).Row

  ' build lookup to row number from source sheet match column
  Dim dict As Object, sKey As String, sValue As String
  Set dict = CreateObject("Scripting.Dictionary")

  With wsSource
  For iRow = 1 To iLastSourceRow
      If .Range(COL_SOURCE & iRow).Value <> "" Then
          sKey = CStr(.Range(COL_MATCH & iRow).Value)
          If dict.exists(sKey) Then
              Debug.Print "Duplicate", sKey, iRow, dict(sKey)
          Else
              dict.Add sKey, iRow
          End If
      End If
  Next
  End With

  ' scan target sheet
  Dim countMatch As Long, countUpdated As Long
  With wsTarget
  For iRow = 1 To iLastTargetRow
      If .Range(COL_TARGET & iRow).Value <> "" Then

          ' match with source file
          sKey = CStr(.Range(COL_MATCH & iRow).value)
          If dict.exists(sKey) Then
              .Range(COL_TARGET & iRow).Value = wsSource.Range(COL_SOURCE & dict(sKey)).Value
              countUpdated = countUpdated + 1
              'Debug.Print iRow, sKey, dict(sKey)
          End If
          countMatch = countMatch + 1
      End If
  Next
  End With

  ' result
  Dim msg As String
  msg = "Matched = " & countMatch & vbCrLf & _
        "Updated = " & countUpdated

  MsgBox msg, vbInformation, "Completed"

End Sub
...