Читать два столбца, используя вложенный цикл for - PullRequest
0 голосов
/ 11 марта 2020

Мне нужно прочитать два столбца, это как сверка Excel, мне нужно захватить столбец B и столбец W, затем столбец B проверить 1 запись и сопоставить эту запись из столбца W, если запись столбца B и запись W столбца совпадают, тогда необходимо переместить новый лист. любой может проверить или посоветовать мне, как это сделать для l oop. и как захватить столбец B & W для вложенного для l oop.

  For i = 2 To 20

   Rows.Cells(i, 2).Select
   Rows.Cells(i, 2).Select
   Rows.Cells(j, 31).Select
      Next j
   Next i

Ответы [ 2 ]

0 голосов
/ 11 марта 2020

Я не уверен, что полностью понимаю, чего вы пытаетесь достичь, но попробуйте это

Option Explicit

Sub runThrough(cbpath As String, bspath As String)

    Dim wbSource As Workbook, wsSource As Worksheet
    Dim wb As Workbook, ws As Worksheet, wsMatch As Worksheet
    Dim iLastRow As Long, iLastRowB As Long, iTargetRow As Long
    Dim t0 As Single, count As Long, matches As Long
    t0 = Timer

    ' cash book
    Set wbSource = Workbooks.Open(cbpath, False, True) ' no link update, read only
    Set wsSource = wbSource.Sheets(1)
    iLastRow = wsSource.Range("A" & Rows.count).End(xlUp).Row

    ' summary
    Set wb = Workbooks.Open(bspath)
    Set ws = wb.Sheets(1)
    iLastRowB = ws.Range("B" & Rows.count).End(xlUp).Row

    ' copy from cashbook to summary
    wsSource.Range("A1:Z" & iLastRow).Copy ws.Range("W1")
    wbSource.Close SaveChanges:=False

    ' create new sheet for matched rows
    Set wsMatch = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.count))
    wsMatch.Name = "matched"

    ' nested loop
    Dim i As Long, j As Long
    Dim colB As String, colW As String
    iTargetRow = 0
    For i = 2 To iLastRowB
       colB = ws.Cells(i, "B")
       For j = 1 To iLastRow
           colW = ws.Cells(j, "W")
           If colB = colW Then
               ' do something
               iTargetRow = iTargetRow + 1
               ws.Rows(j).EntireRow.Copy wsMatch.Cells(iTargetRow + 1, 1)
           End If
           count = count + 1
       Next
    Next

    ' result
    MsgBox count & " iterations " & iTargetRow & "  rows copied to new sheet " & wsMatch.Name, _
           vbInformation, "Completed in " & Int(Timer - t0) & " secs"

End Sub

0 голосов
/ 11 марта 2020

Попробуйте код ниже. Он будет сравнивать столбцы B & W. Если они одинаковые, вся строка копируется на второй лист. ThisWorkbook относится к книге, содержащей код.

Public Sub Test()

    Dim SheetToCheck As Worksheet, SheetToPasteTo As Worksheet
    Dim lRow As Long
    Dim NextEmptyRow As Long

    Set SheetToCheck = ThisWorkbook.Worksheets("Sheet1")
    Set SheetToPasteTo = ThisWorkbook.Worksheets("Sheet2")

    For lRow = 2 To 20
        If SheetToCheck.Cells(lRow, 2) = SheetToCheck.Cells(lRow, 23) Then 'Compare Col B to Col W.
            NextEmptyRow = SheetToPasteTo.Cells(Rows.Count, 2).End(xlUp).Row + 1
            SheetToCheck.Rows(lRow).Copy Destination:=SheetToPasteTo.Rows(NextEmptyRow)
        End If
    Next lRow

End Sub
...