Excel VBA - 。在处理日期时查找不一致

时间:2015-03-24 03:06:37

标签: excel vba excel-vba

我昨天在使用带有日期的.find时发布了一个问题,不幸的是我的问题仍然存在。我的问题是使用.find使用日期作为字符串返回一些没有值与一些源电子表格,但它可以与其他人一起使用。代码如下,是否有任何方法可以使用.find使用日期来获得一致的结果?

更新:我在下面发布了更多代码,以显示代码的总部分及其功能。日期查找部分显示在代码的第二个部分中,第一部分从源和目标电子表格中获取数据,合并它们,然后在源表和目标表中查找匹配项。匹配是人名和发布日期,一旦找到两者的匹配,名称将作为行号返回,并且发布日期将作为列号返回。它使用这些引用来复制/粘贴位于源和目标行/列引用中的单元格值。

Sub MapValues(SourceSheet As Worksheet, TargetSheet As Worksheet, dumpsheet As Worksheet)
Dim Sourcename As String, 
namefind As Range, TargetColumnRange As Range
Dim Sourcelrow As Long, targetlrow As Long,
Dim I As Long, lngCnt As Long
Dim DateStore As Variant
Dim c As Range, D As Range

GoTo Capex
Capex:

'Declare the ranges with Names
SourceSheet.Activate
Sourcelrow = ActiveSheet.Cells(rows.Count, 1).End(xlUp).row
TargetSheet.Activate
targetlrow = ActiveSheet.Cells(rows.Count, 5).End(xlUp).row

'redimension the name storage array



'loop through the source sheet names
SourceSheet.Activate
lngCnt = 2
For I = Sourcelrow To 1 Step -1
    Sourcename = SourceSheet.Range("A" & I).Value


        'find matches in the target sheet
           TargetSheet.Activate
            Set namefind = ActiveSheet.Range("E528:E" & targetlrow).Find(What:=Sourcename, _
                                                               LookIn:=xlValues, _
                                                               LookAt:=xlWhole, _
                                                               SearchOrder:=xlByRows, _
                                                               SearchDirection:=xlNext, _
                                                               MatchCase:=False, _
                                                               SearchFormat:=False)
                   'if a match is found
                   If Not namefind Is Nothing Then
                   dumpsheet.Range("A" & lngCnt).Value = namefind.Value
                   dumpsheet.Range("B" & lngCnt).Value = SourceSheet.Range("A" & I).row
                   dumpsheet.Range("C" & lngCnt).Value = namefind.row
                   lngCnt = lngCnt + 1
                   End If
Next I

Dim namerow As Long, actualrow As Long, actualcolumnsource As Long, actualcolumntarget As Long, daterow As Long
Dim actualcost As Range
Dim actualcostvalue As String, targetcolumn As String
Dim F As Long, G As Long, H As Long


dumpsheet.Activate
namerow = dumpsheet.Cells(rows.Count, 1).End(xlUp).row
actualcolumnsource = SourceSheet.Cells(5, Columns.Count).End(xlToRight).row
actualcolumntarget = 44

lngCnt = 0
TargetSheet.Activate

'Create the Column Matches
ReDim DateStore(0 To actualcolumnsource)
For lngCnt = LBound(DateStore, 1) To UBound(DateStore, 1)
   If lngCnt = 0 Then
    DateStore(lngCnt) = SourceSheet.Cells(5, lngCnt + 1).Value
   Else
    DateStore(lngCnt) = SourceSheet.Cells(5, lngCnt).Value
   End If
Next lngCnt
dumpsheet.Range("E2").Resize((UBound(DateStore) - LBound(DateStore)) + 1, 1).Value = _
                                  Application.Transpose(DateStore)
lngCnt = 0
Erase DateStore

ReDim DateStore(0 To actualcolumnsource)
For lngCnt = LBound(DateStore, 1) To UBound(DateStore, 1)
   If lngCnt = 0 Then
    DateStore(lngCnt) = SourceSheet.Cells(5, lngCnt + 1).Column
   Else
    DateStore(lngCnt) = SourceSheet.Cells(5, lngCnt).Column
   End If
Next lngCnt
dumpsheet.Range("F2").Resize((UBound(DateStore) - LBound(DateStore)) + 1, 1).Value = _
                                  Application.Transpose(DateStore)

ReDim DateStore(0 To actualcolumntarget)
For lngCnt = LBound(DateStore, 1) To UBound(DateStore, 1)
   If lngCnt = 0 Then
    DateStore(lngCnt) = TargetSheet.Cells(5, lngCnt + 1).Value
   Else
    DateStore(lngCnt) = TargetSheet.Cells(5, lngCnt).Value
   End If
Next lngCnt
dumpsheet.Range("G2").Resize((UBound(DateStore) - LBound(DateStore)) + 1, 1).Value = _
                                  Application.Transpose(DateStore)


lngCnt = 0
Erase DateStore


ReDim DateStore(0 To actualcolumntarget)
For lngCnt = LBound(DateStore, 1) To UBound(DateStore, 1)
   If lngCnt = 0 Then
    DateStore(lngCnt) = TargetSheet.Cells(5, lngCnt + 1).Column
   Else
    DateStore(lngCnt) = TargetSheet.Cells(5, lngCnt).Column
   End If
Next lngCnt
dumpsheet.Range("H2").Resize((UBound(DateStore) - LBound(DateStore)) + 1, 1).Value = _
                                  Application.Transpose(DateStore)

lngCnt = 0
Erase DateStore


'Format the date ranges as dates before date match commences.


On Error Resume Next
For Each c In dumpsheet.UsedRange.Columns("G").Cells
    If Not IsEmpty(c) Then
    c.Value = CDate(c.Value)
    c.NumberFormat = "mm/dd/yyyy"
    End If
Next c


For Each D In dumpsheet.UsedRange.Columns("E").Cells
   If Not IsEmpty(D) Then
   D.Value = CDate(D.Value)
   D.NumberFormat = "mm/dd/yyyy"
   End If
Next D

第2节:

Dim SourceColumnValue As String, sourcerow As String, targetrow As String, targetcolumnvalue As String, sourcecolumnnumber As String
Dim M As Long, O As Long, TargetValue As Long, actualsourcerow As Long, actualtargetrow As Long, actualtargetcolumn As Long, sourcedateposition As Long, actualsourcecolumn 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
'Loop Source Column
For F = 1 To sourcedateposition
SourceColumnValue = dumpsheet.Cells(F, 5).Value
       'Get Target Column Match to Source
       Set TargetColumnRange = dumpsheet.Range("G2:G" & TargetValue).Find(What:=DateValue(SourceColumnValue), _
                                                               LookIn:=xlFormulas, _
                                                               LookAt:=xlWhole, _
                                                               SearchOrder:=xlByRows, _
                                                               SearchDirection:=xlNext, _
                                                               MatchCase:=False, _
                                                               SearchFormat:=False)

                   'if a match is found
                   If Not TargetColumnRange Is Nothing Then
                       TargetColumnRange.Value = SourceColumnValue
                       targetcolumnvalue = dumpsheet.Cells(TargetColumnRange.row, 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

                           actualsourcerow = CInt(sourcerow)
                           actualtargetrow = CInt(targetrow)
                           actualtargetcolumn = CInt(targetcolumnvalue)
                           actualsourcecolumn = CInt(sourcecolumnnumber)

                           Set Copysource = SourceSheet.Cells(actualsourcerow, actualsourcecolumn)
                           Set pastetarget = TargetSheet.Cells(actualtargetrow, actualtargetcolumn)
                           Copysource.Copy
                           pastetarget.PasteSpecial (xlPasteValues)
                          End If
                      Next O
                   End If

Next F





CleanUp:

'Set Loop
End Sub

0 个答案:

没有答案