清华大佬耗费三个月吐血整理的几百G的资源，免费分享！....>>>
Sub InitialData()
Sheets("Sheet1").Select
Range("B27").Select
ActiveCell.FormulaR1C1 = "len("""")"
Range("B35").Select
ActiveCell.FormulaR1C1 = "code(""t"")"
Range("B36").Select
Sheets("Sheet2").Select
Range("K22").Select
ActiveCell.FormulaR1C1 = "zip001"
Range("K23").Select
ActiveCell.FormulaR1C1 = "zip001"
Range("K24").Select
ActiveCell.FormulaR1C1 = "zip001"
Range("K25").Select
ActiveCell.FormulaR1C1 = "zip001"
Range("K26").Select
ActiveCell.FormulaR1C1 = "zip001"
Range("K27").Select
ActiveCell.FormulaR1C1 = "zip001"
Range("K28").Select
ActiveCell.FormulaR1C1 = "zip002"
Range("K29").Select
ActiveCell.FormulaR1C1 = "zip003"
Range("K30").Select
ActiveCell.FormulaR1C1 = "zip004"
Range("K31").Select
ActiveCell.FormulaR1C1 = "zip005"
Range("K32").Select
ActiveCell.FormulaR1C1 = "zip006"
Range("K33").Select
ActiveCell.FormulaR1C1 = "zip007"
Range("K34").Select
ActiveCell.FormulaR1C1 = "zip008"
Range("K35").Select
ActiveCell.FormulaR1C1 = "zip009"
Range("K36").Select
ActiveCell.FormulaR1C1 = "zip010"
Range("K37").Select
ActiveCell.FormulaR1C1 = "zip010"
Range("K38").Select
ActiveCell.FormulaR1C1 = "zip011"
Range("K39").Select
ActiveCell.FormulaR1C1 = "zip012"
Range("K40").Select
ActiveCell.FormulaR1C1 = "zip013"
Range("K41").Select
ActiveCell.FormulaR1C1 = "zip014"
Range("K42").Select
ActiveCell.FormulaR1C1 = "zip015"
Range("K43").Select
ActiveCell.FormulaR1C1 = "zip016"
Range("K44").Select
ActiveCell.FormulaR1C1 = "zip017"
Range("K45").Select
ActiveCell.FormulaR1C1 = "zip018"
Range("L22").Select
ActiveCell.FormulaR1C1 = "aceO1"
Range("L23").Select
ActiveCell.FormulaR1C1 = "aceO2"
Range("L24").Select
ActiveCell.FormulaR1C1 = "aceO3"
Range("L25").Select
ActiveCell.FormulaR1C1 = "aceO4"
Range("L26").Select
ActiveCell.FormulaR1C1 = "aceO5"
Range("L27").Select
ActiveCell.FormulaR1C1 = "aceO6"
Range("L28").Select
ActiveCell.FormulaR1C1 = "rar_ace"
Range("L29").Select
ActiveCell.FormulaR1C1 = "aceO8"
Range("L30").Select
ActiveCell.FormulaR1C1 = "aceO9"
Range("L31").Select
ActiveCell.FormulaR1C1 = "aceO10"
Range("L32").Select
ActiveCell.FormulaR1C1 = "aceO11"
Range("L33").Select
ActiveCell.FormulaR1C1 = "aceO12"
Range("L34").Select
ActiveCell.FormulaR1C1 = "aceO13"
Range("L35").Select
ActiveCell.FormulaR1C1 = "aceO14"
Range("L36").Select
ActiveCell.FormulaR1C1 = "rar_ace"
Range("L37").Select
ActiveCell.FormulaR1C1 = "aceO16"
Range("L38").Select
ActiveCell.FormulaR1C1 = "aceO17"
Range("L39").Select
ActiveCell.FormulaR1C1 = "aceO18"
Range("L40").Select
ActiveCell.FormulaR1C1 = "aceO19"
Range("L41").Select
ActiveCell.FormulaR1C1 = "aceO20"
Range("L42").Select
ActiveCell.FormulaR1C1 = "aceO21"
Range("L43").Select
ActiveCell.FormulaR1C1 = "aceO22"
Range("L44").Select
ActiveCell.FormulaR1C1 = "aceO23"
Range("L45").Select
ActiveCell.FormulaR1C1 = "aceO24"
Range("L46").Select
Sheets("Sheet3").Select
Range("C2").Select
ActiveCell.FormulaR1C1 = "my"
Range("D2").Select
ActiveCell.FormulaR1C1 = "77s"
Range("F2").Select
ActiveCell.FormulaR1C1 = "my"
Range("G2").Select
ActiveCell.FormulaR1C1 = "77s"
Range("H2").Select
ActiveCell.FormulaR1C1 = "ttt"
Range("J2").Select
ActiveCell.FormulaR1C1 = "my"
Range("K2").Select
ActiveCell.FormulaR1C1 = "77s"
Range("L2").Select
ActiveCell.FormulaR1C1 = "ttt"
Range("N3").Select
ActiveCell.FormulaR1C1 = "my"
Range("N4").Select
ActiveCell.FormulaR1C1 = "77s"
Range("N5").Select
ActiveCell.FormulaR1C1 = "ttt"
Range("N13").Select
ActiveCell.FormulaR1C1 = "my"
Range("N14").Select
ActiveCell.FormulaR1C1 = "77s"
Range("N15").Select
ActiveCell.FormulaR1C1 = "ttt"
End Sub
Sub GroupData()
With Worksheets("Sheet2")
Dim EndRow As Long
Dim CompanyEndRow As Long
Dim r As Range
Dim FindCell As Range
Dim CompanyCount As Integer
.Activate
EndRow = IIf(.Range("K22").End(xlDown).Row = 1048576, 22, .Range("K22").End(xlDown).Row)
CompanyEndRow = IIf(Worksheets("Sheet3").Range("C3").End(xlDown).Row = 1048576, 3, Worksheets("Sheet3").Range("F3").End(xlDown).Row)
Worksheets("Sheet3").Range("C3:" & "D" & CompanyEndRow).ClearContents
Worksheets("Sheet3").Range("F3:" & "H" & (3 + 9 * 3 - 1)).ClearContents
Worksheets("Sheet3").Range("J3:" & "L" & (3 + 9 * 3 - 1)).ClearContents
Worksheets("Sheet3").Range("J3:" & "L" & (3 + 9 * 3 - 1)).ClearContents
Worksheets("Sheet3").[O3:O5].ClearContents
Worksheets("Sheet3").[O13:O15].ClearContents
.Range("K22:K" & EndRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("Sheet3").Range("C3"), Unique:=True
With Worksheets("Sheet3")
If .Range("C3").End(xlDown).Row = 1048576 Then
CompanyEndRow = 3
Else
.Range("C3:C" & .Range("C3").End(xlDown).Row).RemoveDuplicates Columns:=1, Header:=xlNo
CompanyEndRow = IIf(.Range("C3").End(xlDown).Row = 1048576, 3, .Range("C3").End(xlDown).Row)
End If
End With
For Each r In .Range("K22:K" & EndRow)
If r.Offset(0, 1).Value <> "rar_ace" Then
Set FindCell = Worksheets("Sheet3").Range("C3:C" & CompanyEndRow).Find(What:=r.Value, After:=Worksheets("Sheet3").Range("C3"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False)
If Not FindCell Is Nothing Then
FindCell.Offset(0, 1).Value = IIf(FindCell.Offset(0, 1).Value = "", r.Offset(0, 1).Value, FindCell.Offset(0, 1).Value & "," & r.Offset(0, 1).Value)
End If
End If
Next r
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
With Worksheets("Sheet3")
For Each r In .Range("C3:C" & CompanyEndRow)
CompanyCount = CompanyCount + 1
If CompanyCount <= 9 Then
.Range("F" & (3 + (CompanyCount - 1) * 3)).Value = .Range("C" & (3 + CompanyCount - 1)).Value
.Range("F" & (3 + (CompanyCount - 1) * 3) + 1).Value = .Range("C" & (3 + CompanyCount - 1)).Value
.Range("F" & (3 + (CompanyCount - 1) * 3) + 2).Value = .Range("C" & (3 + CompanyCount - 1)).Value
.Range("G" & (3 + (CompanyCount - 1) * 3)).Value = "A"
.Range("G" & (3 + (CompanyCount - 1) * 3) + 1).Value = .Range("D" & (3 + CompanyCount - 1)).Value
.Range("G" & (3 + (CompanyCount - 1) * 3) + 2).Value = "B"
.Range("H" & (3 + (CompanyCount - 1) * 3)).Value = "AA"
.Range("H" & (3 + (CompanyCount - 1) * 3) + 1).Value = "BB"
.Range("H" & (3 + (CompanyCount - 1) * 3) + 2).Value = "CC"
Else
.Range("J" & (3 + (CompanyCount - 9 - 1) * 3)).Value = .Range("C" & (3 + CompanyCount - 1)).Value
.Range("J" & (3 + (CompanyCount - 9 - 1) * 3) + 1).Value = .Range("C" & (3 + CompanyCount - 1)).Value
.Range("J" & (3 + (CompanyCount - 9 - 1) * 3) + 2).Value = .Range("C" & (3 + CompanyCount - 1)).Value
.Range("K" & (3 + (CompanyCount - 9 - 1) * 3)).Value = "A"
.Range("K" & (3 + (CompanyCount - 9 - 1) * 3) + 1).Value = .Range("D" & (3 + CompanyCount - 1)).Value
.Range("K" & (3 + (CompanyCount - 9 - 1) * 3) + 2).Value = "B"
.Range("L" & (3 + (CompanyCount - 9 - 1) * 3)).Value = "AA"
.Range("L" & (3 + (CompanyCount - 9 - 1) * 3) + 1).Value = "BB"
.Range("L" & (3 + (CompanyCount - 9 - 1) * 3) + 2).Value = "CC"
End If
Next r
CompanyEndRow = IIf(.Range("F3").End(xlDown).Row = 1048576, 3, .Range("F3").End(xlDown).Row)
For Each r In .Range("F3:F" & CompanyEndRow)
.[O3].Value = IIf(.[O3].Value = "", r.Value, .[O3].Value & "|" & r.Value)
.[O4].Value = IIf(.[O4].Value = "", r.Offset(0, 1).Value, .[O4].Value & "|" & r.Offset(0, 1).Value)
.[O5].Value = IIf(.[O5].Value = "", r.Offset(0, 2).Value, .[O5].Value & "|" & r.Offset(0, 2).Value)
Next r
CompanyEndRow = IIf(.Range("J3").End(xlDown).Row = 1048576, 3, .Range("J3").End(xlDown).Row)
For Each r In .Range("J3:J" & CompanyEndRow)
.[O13].Value = IIf(.[O13].Value = "", r.Value, .[O13].Value & "|" & r.Value)
.[O14].Value = IIf(.[O14].Value = "", r.Offset(0, 1).Value, .[O14].Value & "|" & r.Offset(0, 1).Value)
.[O15].Value = IIf(.[O15].Value = "", r.Offset(0, 2).Value, .[O15].Value & "|" & r.Offset(0, 2).Value)
Next r
.Activate
End With
With Worksheets("Sheet1")
.[C3].Formula = "=" & .[B27].Value & ""
.[C7].Formula = "=" & .[B35].Value & ""
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End With
End Sub