Excel VBA - cannot .find date string in range

前端 未结 2 1413
我在风中等你
我在风中等你 2021-01-23 05:49

I wrote some VBA script to search a range of dates in a list, it can find the dates, but for some reason it cannot match them to the target range. I tested the target range wit

相关标签:
2条回答
  • 2021-01-23 05:53

    I managed to write some code using a loop rather than using the .find which happened to be very inconsistent with dates. I read in another article that using strings for dates is better because the actual numerical value of the date gets stored in the string. I converted the source and target dates to strings and then did a match using a loop which works well. But thank you for your answer, it did put me on the right track!

    See below

    Dim SourceColumnValue As String, sourcerow As String, targetrow As String, targetcolumnvalue As String, sourcecolumnnumber As String
    Dim M As Long, O As Long, P As Long, TargetValue As Long, actualsourcerow As Long, actualtargetrow As Long, actualtargetcolumn As Long, sourcedateposition As Long, actualsourcecolumn As Long, targetdateposition As Long
    Dim Copysource As Range, pastetarget As Range
    
    TargetValue = dumpsheet.Cells(rows.Count, 1).End(xlUp).row
    sourcedateposition = dumpsheet.Cells(rows.Count, 5).End(xlUp).row
    targetdateposition = dumpsheet.Cells(rows.Count, 7).End(xlUp).row
    
    'Loop Source Column
    For F = 1 To sourcedateposition
    SourceColumnValue = dumpsheet.Cells(F, 5).Value
           'Get Target Column Match to Source
    
                    ' Loop to compare strings
                        For P = 1 To targetdateposition
                        targetcolumnvalue = dumpsheet.Cells(P, 7).Value
                        If targetcolumnvalue = SourceColumnValue Then
    
                           TargetColumnRange.Value = SourceColumnValue
                           targetcolumnvalue = dumpsheet.Cells(P, 8).Value
                           sourcecolumnnumber = dumpsheet.Cells(F, 6).Value
    
                           For O = 1 To dumpsheet.Cells(rows.Count, "a").End(xlUp).row
                               If O > 1 Then
                               Sourcename = dumpsheet.Cells(O, 1).Value
                               sourcerow = dumpsheet.Cells(O, 2).Value
                               targetrow = dumpsheet.Cells(O, 3).Value
    
                               'Set Integers
                               actualsourcerow = CInt(sourcerow)
                               actualtargetrow = CInt(targetrow)
                               actualtargetcolumn = CInt(targetcolumnvalue)
                               actualsourcecolumn = CInt(sourcecolumnnumber)
    
    
                               'Copy and Paste
                               Set Copysource = SourceSheet.Cells(actualsourcerow, actualsourcecolumn)
                               Set pastetarget = TargetSheet.Cells(actualtargetrow, actualtargetcolumn)
                               Copysource.Copy
                               pastetarget.PasteSpecial (xlPasteValues)
                              End If
                          Next O
                       End If
                    Next P
    Next F
    
    0 讨论(0)
  • 2021-01-23 06:11

    Using FIND with dates is finnicky, see here

    Your code worked on my tested when I changed

    Set TargetColumnRange = dumpsheet.Range("G2:G" & TargetValue).Find(what:=SourceColumnValue, _
                                                               LookIn:=xlFormulas, _
                                                               LookAt:=xlWhole, _
                                                               SearchOrder:=xlByRows)
    

    to

    Set TargetColumnRange = dumpsheet.Range("G2:G" & TargetValue).Find(what:=DATEVALUE(SourceColumnValue), _
                                                               LookIn:=xlFormulas, _
                                                               LookAt:=xlWhole, _
                                                               SearchOrder:=xlByRows)
    
    0 讨论(0)
提交回复
热议问题