exchange.rar (42.41 KB)【資料名稱】：exchange.xlsm

【資料作者】：ccl

【資料日期】：2011.08.17

【資料語言】：中文

【資料格式】：XLS

【資料目錄和簡介】：
從日常工參到鼎立工參,免去一列列vlookup 或復制的麻煩
Sub 工參生成()
工參全名 = Application.GetOpenFilename
Workbooks.Open 工參全名, False
Application.DisplayAlerts = False
工參路徑 = Application.ActiveWorkbook.Path
工參名 = Application.ActiveWorkbook.Name
工參表 = ActiveSheet.Name
Range("A1").Select
Selection.End(xlDown).Select
行數(shù) = ActiveCell.Row '當前單元格行號
ActiveWorkbook.SaveAs Filename:="xxx.xlsx", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Application.DisplayAlerts = False
Windows("exchange.xlsm").Activate
'-----------數(shù)據(jù)----------------------------------------
Range("A2") = "=[" + "xxx" + "]" + 工參表 + "!$H2"
'基站名稱
Range("B2") = "=[" + "xxx" + "]" + 工參表 + "!$G2"
'MSC
Range("C2") = "=[" + "xxx" + "]" + 工參表 + "!$F2"
'BSC
Range("D2") = "=[" + "xxx" + "]" + 工參表 + "!$M2"
'LAC
Range("E2") = "=[" + "xxx" + "]" + 工參表 + "!$N2"
'CI
Range("F2") = "=CONCATENATE(D2,"""",E2)"
'LACCI
Range("G2") = "=[" + "xxx" + "]" + 工參表 + "!$B2"
'廠家
Range("H2") = "=[" + "xxx" + "]" + 工參表 + "!$E2"
'cellName
Range("I2") = "=IF(L2>511,0.15,0.075)"
'TITLE
Range("J2") = "=[" + "xxx" + "]" + 工參表 + "!$K2"
'區(qū)域
Range("K2") = "=[" + "xxx" + "]" + 工參表 + "!$Q2"
'HopType
Range("L2") = "=[" + "xxx" + "]" + 工參表 + "!$S2"
'BCCH
Range("M2") = "=[" + "xxx" + "]" + 工參表 + "!$T2"
'BSIC
Range("N2") = "=[" + "xxx" + "]" + 工參表 + "!$U2"
'TCH
Range("AM2") = "=[" + "xxx" + "]" + 工參表 + "!$V2"
'Longitude
Range("AN2") = "=[" + "xxx" + "]" + 工參表 + "!$W2"
'Latitude
Range("AO2") = "=[" + "xxx" + "]" + 工參表 + "!$X2"
'Azimuth
Range("AP2") = "=[" + "xxx" + "]" + 工參表 + "!$Y2"
'機械下傾角
Range("AQ2") = "=[" + "xxx" + "]" + 工參表 + "!$Y2"
'電下傾
Range("AR2") = "=[" + "xxx" + "]" + 工參表 + "!$Z2"
'掛高
Range("AS2") = "=[" + "xxx" + "]" + 工參表 + "!$AA2"
'天線廠家
Range("AT2") = "=[" + "xxx" + "]" + 工參表 + "!$AB2"
'天線型號
Range("AU2") = "=IF(L2>511,0.15,0.075)"
'LENGTH
Range("AV2") = "0"
'BTS
Range("AW2") = "0"
'BCF
'Range("C2") = "=right([" + "xxx" + "]" + 工參表 + "!$e2,1)"
'Range("D2") = "=[" + "xxx" + "]" + 工參表 + "!$H2"
'Range("B2") = "=CONCATENATE(A2,""-"",D2)"
'Range("e2") = "=[" + "xxx" + "]" + 工參表 + "!$Af2"
'Range("f2") = "=[" + "xxx" + "]" + 工參表 + "!$Ag2"
'Range("h2") = "=[" + "xxx" + "]" + 工參表 + "!$Ae2"
'Range("i2") = "=[" + "xxx" + "]" + 工參表 + "!$l2"
'Range("j2") = "=[" + "xxx" + "]" + 工參表 + "!$m2"
'Range("k2") = "=[" + "xxx" + "]" + 工參表 + "!$z2"
'Range("$g$2") = "283"

'-----------數(shù)據(jù)----------------------------------------

Range("A2:AW2").Select
aa = "A2:AW"
c = LTrim(Str(行數(shù)))
bb = c
Dim dada As String
dada = Date
Selection.AutoFill Destination:=Range(aa + bb), Type:=xlFillDefault

'填充
Range("N2").Select
Range(Selection, Selection.End(xlDown)).Copy
Range("N2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(Selection, Selection.End(xlDown)).TextToColumns Destination:=Range("N2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True

'分列
Range("N2") = "=[" + "xxx" + "]" + 工參表 + "!$U2"
Range("N2").Select
aa = "N2:N"
Range("N2").Select
Selection.AutoFill Destination:=Range(aa + bb), Type:=xlFillDefault
'TCH

路徑 = ThisWorkbook.Path
ActiveWorkbook.SaveAs Filename:= _
工參路徑 + "\" + "石家莊工參" + dada + ".csv", FileFormat:=xlCSV, _
CreateBackup:=False
Workbooks.Open Filename:=路徑 + "\" + "exchange.xlsm"
Workbooks("xxx.xlsx").Activate
Application.ActiveWorkbook.Close savechanges:=False
Kill (工參路徑 + "\" + "xxx.xlsx")
Workbooks("石家莊工參" & dada & ".csv").Activate
Application.ActiveWorkbook.Close savechanges:=False
End Sub