我昨天在使用带有日期的.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