Excel VBA сверка - PullRequest
       20

Excel VBA сверка

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

У меня есть книга Excel, и мне нужно сравнить столбец B и столбец W, если данные столбца B & W совпадают, необходимо скопировать всю строку в информационный лист (имя листа "Согласовано"). Данные столбца B имеют формат даты, подобный этому ( 2020-02-01 07: 55: 08.0) столбец W формат даты такой (27/01/2020) Столбец B & W нужно сравнивать с датой.
эта кодовая дата выбрана, но она работает, но она неправильно.

Sub runThrough(cbpath As String, bspath As String)

Dim  newcashBook, newbankstmt As Worksheet
Dim cashbook, Bankstmt As Workbook
Dim i, j As Long
Dim cbRecords, bsRecords rng As String

Set cashbook = Workbooks.Open(cbpath)

   'copy data from another workbook
 Set newcashBook = cashbook.Sheets(1) 
 newcashBook.Range("A1:Z1048576").Copy
 cashbook.Close

      'paste data to W1 row from another workbook
    Set newbankstmt = ThisWorkbook.Sheets("Sheet0") 
    newbankstmt.Range("W1").PasteSpecial


 For i = 2 To 100
  Set newbankstmt = ThisWorkbook.Sheets("Sheet0")
  ' Sheet0 is activeworkbook active worksheet
   Rows.Cells(i, 2).Select

  Rows.Cells(i, 2).Select
      For j = 2 To 100 

        Rows.Cells(j, 31).Select

                 If (i = j) Then
                    Debug.Print "yes"   'check data same or not
                 Else
                    Debug.Print "wrong"

                 End If
 Next j
  Next i
End Sub

Ответы [ 2 ]

1 голос
/ 12 марта 2020

Я подготовил код, основанный на том, что я могу вывести из вашего вопроса и комментариев. Итак, код копирует, как можно быстрее (с использованием массива) содержимое cashbook.Sheets(1) в newbankstmt.Range("W1").

, затем он перебирает между 100 строками и, если "B" ячейка Date по указанному c строка равна дате ячейки "W" в той же строке, тогда адрес ярости "A: W" соответствующей строки возвращается в Immediate Window, и код останавливается. Вы можете go перейти к следующему такому событию, нажав F5. Чтобы увидеть возвращенное значение в Immediate Window, вы должны нажать Ctrl + G.

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

Этот код не заботится о формате ячейки (даты). Но код будет работать только в том случае, если обе обсуждаемые ячейки (B и W) имеют тип даты .

Sub runThrough(cbpath As String, bspath As String)
 Dim newcashBook As Worksheet, newbankstmt As Worksheet
 Dim cashbook As Workbook, Bankstmt As Workbook
 Dim i As Long, dateB As Date, dateW As Date, arrC As Variant

 Set cashbook = Workbooks.Open(cbpath)
   'copy data from cashbook:
   Set newcashBook = cashbook.Sheets(1)
   'input the big range in arrC array:
   arrC = newcashBook.Range("A1:Z1048576").value
 cashbook.Close

    'copy the arrC content starting from W1:
    Set newbankstmt = ThisWorkbook.Sheets("Sheet0")
    newbankstmt.Range("W1").Resize(UBound(arrC, 1), UBound(arrC, 2)).value = arrC


 For i = 2 To 100 'why To 100?
    dateB = newbankstm.Cells(i, "B").value
    dateW = newbankstm.Cells(i, "W").value
    If DateSerial(Year(dateB), Month(dateB), Day(dateB)) = DateSerial(Year(dateW), Month(dateW), Day(dateW)) Then
        Debug.Print "Range to be copied: " & newbankstm.Range(newbankstm.Cells(i, 1), _
                                                    newbankstm.Cells(i, "W")).Address
        Stop
    End If
 Next i
End Sub
1 голос
/ 12 марта 2020

Ниже проверьте, действительны ли обе даты, и проверьте, совпадают ли они. Изменить и использовать:

Sub populate_sales()

    Dim bDate As Date, wDate As Date

    With ThisWorkbook.Worksheets("Sheet1")

        'Check if both date are valid
        If IsDate(.Range("B1").Value) And IsDate(.Range("W1").Value) Then

            bDate = Year(.Range("B1").Value) & "-" & Right("0" & Month(.Range("B1").Value), 2) & "-" & Right("0" & Day(.Range("B1").Value), 2)
            wDate = Year(.Range("W1").Value) & "-" & Right("0" & Month(.Range("W1").Value), 2) & "-" & Right("0" & Day(.Range("W1").Value), 2)

            If bDate = wDate Then
                'Copy
            End If
        Else
            MsgBox "Invalid dates"
        End If
    End With

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...