|
第一步用Dictionary非常简单
For ii = 1 To Rng.Rows.Count
oDate = Format(Rng(ii, 1), "yyyy/mm/dd hh:mm")
Dict(oDate) = ""
Next ii
第二次用Dictionary转不弯
For jj = 1 To Rng.Rows.Count
oDate = Format(Rng(jj, 1), "yyyy/mm/dd hh:mm")
'Debug.Print Dict.Keys(ii) = oDate, Dict.Keys(ii); oDate
If Dict.Keys(ii) = oDate Then
oDict(Rng(ii, 1)) = Rng(ii, 2).Address
Else
Dict.Keys(ii) = oDict.Items
End If
Next jj
目的
表2的单元格地址,与表的想对应。
- Sub MergeAndSortSheets()
- Dim Sht1 As Worksheet, Sht2 As Worksheet, Sht3 As Worksheet
- Dim lastRow1 As Long, lastRow2 As Long, lastRow3 As Long
- Dim ii As Long, jj As Long
- Dim Dict1 As Dictionary, Dict2 As Dictionary
- Dim Dict As Dictionary
- Set Sht1 = Sheets(1)
- Sht1.Name = "First"
- Set Sht2 = Sheets(2)
- Sht2.Name = "Second"
- Set Sht3 = Sheets(3)
- With Sht3
- .Cells.Clear
- .Cells.Font.Size = 9
- If .Name <> "MergedSorted" Then
- .Name = "MergedSorted"
- End If
- .Activate
- End With
- Dim Rng1 As Range, Rng2 As Range, Rng3 As Range
- Set Rng1 = Sht1.Cells(15, 1).CurrentRegion
- Rng1.Copy
-
- Set Rng2 = Sht2.Cells(15, 1).CurrentRegion
- Sht3.Cells(5, 1).PasteSpecial Paste:=xlPasteAll
- Set Rng3 = Sht3.Cells(10, 1).CurrentRegion
- Set Dict = DateDict(Rng3)
- Set aa = Dict.Items(1)
-
- Stop
- Stop
-
- End Sub
- Function DateDict(Rng As Range)
- Debug.Print Rng.Address; Rng.Parent.Name
- Dim Dict As Dictionary, oDict As Dictionary
- Set Dict = New Dictionary
- Set oDict = New Dictionary
- Dim oDate As Date
-
- For ii = 1 To Rng.Rows.Count
- oDate = Format(Rng(ii, 1), "yyyy/mm/dd hh:mm")
- Dict(oDate) = ""
- Next ii
- For ii = 0 To Dict.Count - 1
-
- For jj = 1 To Rng.Rows.Count
- oDate = Format(Rng(jj, 1), "yyyy/mm/dd hh:mm")
- 'Debug.Print Dict.Keys(ii) = oDate, Dict.Keys(ii); oDate
- If Dict.Keys(ii) = oDate Then
- oDict(Rng(ii, 1)) = Rng(ii, 2).Address
- Else
- Dict.Keys(ii) = oDict.Items
- End If
- Next jj
- Next ii
-
- Set DateDict = Dict
-
- End Function
复制代码
|
|