VBA находит подходящие пары в столбце с данными

Question

Я новичок в VBA и мне нужна помощь, чтобы решить эту проблему. Как показано, у нас есть sheet1 с набором статей для каждого местоположения. В sheet2 у нас есть соответствующие пары со статьями. Цель состоит в том, чтобы найти каждую пару из shee2 в каждом местоположении, заданном из sheet1, и, если оно истинно, перейти к sheet3. Остальные статьи из листа1 мы можем сопоставить случайным образом.

Answer 1

Является ли вопрос, как сравнить 2 листа ячейки для ячейки? Для примера sheet1.A1 == sheet2.A1? И если это правда, переместите его на лист 3?

Если так, сделайте это так:

'ws1 and ws2 must be defined by you
Dim ws1 As worksheet, Dim ws2 as Worksheet
Dim ws1Row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer
Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As 
String
Dim report As Workbook, difference As Long
Dim row As Long, col As Integer
Dim rowForList As Variant
Dim colForList As Variant
Set report = Workbooks.Add

'Count rows on first worksheet
With ws1.UsedRange
    ws1Row = .Rows.Count
    ws1col = .Columns.Count
End With

'Count rows on second worksheet
With ws2.UsedRange
    ws2row = .Rows.Count
    ws2col = .Columns.Count
End With

'define variables maxrow und maxcol 
 maxrow = ws1Row
 maxcol = ws1col

 'check if maxrow and maxcol are correct
 If maxrow < ws2row Then maxrow = ws2row
 If maxcol < ws2col Then maxcol = ws2col

 'count differences
 difference = 0

 'creating column names
 report.Cells(1, 1).Value = "location"
 report.Cells(1, 2).Value = "art1"
 report.Cells(1, 3).Value = "art2"

 'Variables to count for the list
 rowForList = 2
 colForList = 1


     For row = 1 To maxrow

         For col = 1 To maxcol

                  'Find out which cells have different values

                  DoEvents

                  colval1 = ""
                  colval2 = ""
                  colval1 = ws1.Cells(row, col).Value
                  colval2 = ws2.Cells(row, col).Value

                  'compare if cells are unequal
                  If colval1 <> colval2 Then
                  difference = difference + 1

                  If (IsEmpty(ws1.Cells(row, 1))) Then
                     report.Cells(rowForList, colForList).Value = ws2.Cells(row, 1).Value
                  Else
                     report.Cells(rowForList, colForList).Value = ws1.Cells(row, 1).Value
                  End If


                 report.Cells(rowForList, colForList + 1).Value = ws1.Cells(1, col).Value
                 report.Cells(rowForList, colForList + 2).Value = colval1
                 report.Cells(rowForList, colForList + 3).Value = colval2

                 rowForList = rowForList + 1


             End If

         Next col

Next row

Возможно, вам придется изменить некоторые вещи для себя, но это может быть то, что вам нужно .