我想创建一个i脚本，我可以从另一个工作簿中提取特定数据，我有一个名为"Masterfile"的源文件我想从Column C(Header 3)获取Column C的所有数据如果来自1 Column C的值未执行任何操作，则为is NOT 1。
样品：
Header1 | Header2 | Header3 |
blue | blue | 1 |
blue | blue | 1 |
red | red | null |
red | red | null |
yellow | yellow | 1 |
yellow | yellow | 1 |
yellow | yellow | |
输出：
Header1 | Header2 | Header3 |
blue | blue | 1 |
blue | blue | 1 |
yellow | yellow | 1 |
yellow | yellow | 1 |
我的代码：
Public Sub createRepairReport(wbNew)
Dim wksht1 As Worksheet, wksht2 As Worksheet
Dim outputWksht As Worksheet
Dim lngLastRow As Long, lngLastMappingRow As Long, lngLastCol As Long
Dim varCabinet As Variant
Dim cabinetRng As Range
Set wksht1 = ThisWorkbook.Sheets("masterfile")
Set wksht2 = ThisWorkbook.Sheets("mapping")
Set outputWksht = wbNew.Worksheets.Add
outputWksht.Name = "Repair Details"
Application.DisplayAlerts = False
'*****HEADER START*****
outputWksht.Cells(1, 1).Value = "OrdStatus"
outputWksht.Cells(1, 2).Value = "OrdNo"
outputWksht.Cells(1, 3).Value = "RefNo"
outputWksht.Cells(1, 4).Value = "FixCode"
outputWksht.Cells(1, 5).Value = "FixDescription"
outputWksht.Cells(1, 6).Value = "FindCode"
outputWksht.Cells(1, 7).Value = "FindDescription"
outputWksht.Cells(1, 8).Value = "FaultCode"
outputWksht.Cells(1, 9).Value = "FaultDescription"
outputWksht.Cells(1, 10).Value = "SvcType"
outputWksht.Cells(1, 11).Value = "OrdCrtDate"
outputWksht.Cells(1, 12).Value = "CustAcNo"
outputWksht.Cells(1, 13).Value = "CustomrName"
outputWksht.Cells(1, 14).Value = "CustClassn"
outputWksht.Cells(1, 15).Value = "NetSvcId"
outputWksht.Cells(1, 16).Value = "InstStDate"
outputWksht.Cells(1, 17).Value = "BillAddress"
outputWksht.Cells(1, 18).Value = "InstAddress"
outputWksht.Cells(1, 19).Value = "ContactName"
outputWksht.Cells(1, 20).Value = "ContactNo"
outputWksht.Cells(1, 21).Value = "FranArea"
outputWksht.Cells(1, 22).Value = "FranDesc"
outputWksht.Cells(1, 23).Value = "SimSn"
outputWksht.Cells(1, 24).Value = "SimModel"
outputWksht.Cells(1, 25).Value = "PhoneSn"
outputWksht.Cells(1, 26).Value = "PhoneModel"
outputWksht.Cells(1, 27).Value = "ModemSn"
outputWksht.Cells(1, 28).Value = "ModemModel"
outputWksht.Cells(1, 29).Value = "Node3GId"
outputWksht.Cells(1, 30).Value = "BtsIdCDMA"
outputWksht.Cells(1, 31).Value = "MDF"
outputWksht.Cells(1, 32).Value = "CABINET"
outputWksht.Cells(1, 33).Value = "CAB_d_st"
outputWksht.Cells(1, 34).Value = "CAB_d_pr"
outputWksht.Cells(1, 35).Value = "DP"
outputWksht.Cells(1, 36).Value = "DP_e_pr"
outputWksht.Cells(1, 37).Value = "DP_add"
outputWksht.Cells(1, 38).Value = "CAB_add"
outputWksht.Cells(1, 39).Value = "Contractor"
outputWksht.Cells(1, 40).Value = "Cluster"
outputWksht.Cells(1, 41).Value = "Region"
outputWksht.Cells(1, 42).Value = "DLY_date"
outputWksht.Cells(1, 43).Value = "COM_date"
outputWksht.Cells(1, 44).Value = "AcvNotes"
outputWksht.Cells(1, 45).Value = "Date of Data Extraction"
outputWksht.Cells(1, 46).Value = "Priority Inspection"
outputWksht.Cells(1, 47).Value = "Basis for Priority"
'wrksht 2
outputWksht.Cells(1, 48).Value = "QA CONTRACTOR"
outputWksht.Cells(1, 49).Value = "QA Contractor Type"
outputWksht.Cells(1, 50).Value = "QA REGION"
outputWksht.Cells(1, 51).Value = "QA REGIONAL AREA"
outputWksht.Cells(1, 52).Value = "QA COS CLUSTER"
outputWksht.Cells(1, 53).Value = "QA COS SUB AREA"
outputWksht.Cells(1, 54).Value = "FO TEAM LEADER"
outputWksht.Cells(1, 55).Value = "QA Team Leader"
outputWksht.Cells(1, 56).Value = "QA Inspector"
'*****HEADER-END*****
'Set the columns to TEXT format
outputWksht.Columns(23).NumberFormat = "@"
outputWksht.Columns(25).NumberFormat = "@"
outputWksht.Columns(27).NumberFormat = "@"
lngLastRow = wksht1.Range("A" & wksht1.Rows.Count).End(xlUp).Row
rownum = 2
For Index = 2 To lngLastRow
outputWksht.Range("A" & rownum).Value = wksht1.Range("C" & Index).Value
outputWksht.Range("B" & rownum).Value = wksht1.Range("D" & Index).Value
outputWksht.Range("C" & rownum).Value = wksht1.Range("E" & Index).Value
outputWksht.Range("D" & rownum).Value = wksht1.Range("G" & Index).Value
outputWksht.Range("E" & rownum).Value = wksht1.Range("H" & Index).Value
outputWksht.Range("F" & rownum).Value = wksht1.Range("I" & Index).Value
outputWksht.Range("G" & rownum).Value = wksht1.Range("J" & Index).Value
outputWksht.Range("H" & rownum).Value = wksht1.Range("K" & Index).Value
outputWksht.Range("I" & rownum).Value = wksht1.Range("L" & Index).Value
outputWksht.Range("J" & rownum).Value = wksht1.Range("N" & Index).Value
outputWksht.Range("K" & rownum).Value = wksht1.Range("O" & Index).Value
outputWksht.Range("L" & rownum).Value = wksht1.Range("Q" & Index).Value
outputWksht.Range("M" & rownum).Value = wksht1.Range("R" & Index).Value
outputWksht.Range("N" & rownum).Value = wksht1.Range("S" & Index).Value
outputWksht.Range("O" & rownum).Value = wksht1.Range("T" & Index).Value
outputWksht.Range("P" & rownum).Value = wksht1.Range("U" & Index).Value
outputWksht.Range("Q" & rownum).Value = wksht1.Range("V" & Index).Value
outputWksht.Range("R" & rownum).Value = wksht1.Range("W" & Index).Value
outputWksht.Range("S" & rownum).Value = wksht1.Range("X" & Index).Value
outputWksht.Range("T" & rownum).Value = wksht1.Range("Y" & Index).Value
outputWksht.Range("U" & rownum).Value = wksht1.Range("AB" & Index).Value
outputWksht.Range("V" & rownum).Value = wksht1.Range("AC" & Index).Value
outputWksht.Range("W" & rownum).Value = wksht1.Range("AE" & Index).Value
outputWksht.Range("X" & rownum).Value = wksht1.Range("AF" & Index).Value
outputWksht.Range("Y" & rownum).Value = wksht1.Range("AH" & Index).Value
outputWksht.Range("Z" & rownum).Value = wksht1.Range("AI" & Index).Value
outputWksht.Range("AA" & rownum).Value = wksht1.Range("AK" & Index).Value
outputWksht.Range("AB" & rownum).Value = wksht1.Range("AL" & Index).Value
outputWksht.Range("AC" & rownum).Value = wksht1.Range("AN" & Index).Value
outputWksht.Range("AD" & rownum).Value = wksht1.Range("AO" & Index).Value
outputWksht.Range("AE" & rownum).Value = wksht1.Range("AP" & Index).Value
outputWksht.Range("AF" & rownum).Value = wksht1.Range("AQ" & Index).Value
outputWksht.Range("AG" & rownum).Value = wksht1.Range("AW" & Index).Value
outputWksht.Range("AH" & rownum).Value = wksht1.Range("AX" & Index).Value
outputWksht.Range("AI" & rownum).Value = wksht1.Range("AY" & Index).Value
outputWksht.Range("AJ" & rownum).Value = wksht1.Range("BA" & Index).Value
outputWksht.Range("AK" & rownum).Value = wksht1.Range("BC" & Index).Value
outputWksht.Range("AL" & rownum).Value = wksht1.Range("AD" & Index).Value
outputWksht.Range("AM" & rownum).Value = wksht1.Range("BE" & Index).Value
' outputWksht.Range("AN" & rownum).Value = wksht1.Range("BF" & Index).Value
outputWksht.Range("AO" & rownum).Value = wksht1.Range("BG" & Index).Value
outputWksht.Range("AP" & rownum).Value = wksht1.Range("BR" & Index).Value
outputWksht.Range("AQ" & rownum).Value = wksht1.Range("BS" & Index).Value
outputWksht.Range("AR" & rownum).Value = wksht1.Range("BY" & Index).Value
outputWksht.Range("AS" & rownum).Value = wksht1.Range("CG" & Index).Value
outputWksht.Range("AT" & rownum).Value
outputWksht.Range("AU" & rownum).Value = wksht1.Range("CH" & Index).Value
outputWksht.Range("AV" & rownum).Value = wksht1.Range("CI" & Index).Value
Dim varcluster As Variant
Dim clusterRng As Range
On Error Resume Next
lngLastMappingRow = wksht2.Range("E" & wksht2.Rows.Count).End(xlUp).Row
Set clusterRng = wksht2.Range("E1:E" & lngLastMappingRow)
varcluster = outputWksht.Range("BA" & rownum).Value
varPosition = Application.WorksheetFunction.Match(varcluster, clusterRng, 0)
If Err = 0 Then
'from wksht4 = "mapping"
outputWksht.Range("AW" & rownum).Value = wksht2.Range("A" & varPosition).Value
outputWksht.Range("AX" & rownum).Value = wksht2.Range("G" & varPosition).Value
outputWksht.Range("AY" & rownum).Value = wksht2.Range("I" & varPosition).Value
outputWksht.Range("AZ" & rownum).Value = wksht2.Range("J" & varPosition).Value
outputWksht.Range("BA" & rownum).Value = wksht2.Range("E" & varPosition).Value
outputWksht.Range("BB" & rownum).Value = wksht2.Range("K" & varPosition).Value
outputWksht.Range("BC" & rownum).Value = wksht2.Range("M" & varPosition).Value
outputWksht.Range("BD" & rownum).Value = wksht2.Range("N" & varPosition).Value
outputWksht.Range("BE" & rownum).Value = wksht2.Range("O" & varPosition).Value
End If
On Error GoTo 0
rownum = rownum + 3
Next
outputWksht.Columns(24).NumberFormat = "0"
outputWksht.Cells.EntireColumn.Font.Size = 8
outputWksht.Rows(1).Font.Size = 10
outputWksht.Cells.EntireColumn.Font.Name = "Calibri"
outputWksht.Range("A1:BE1").Interior.Color = RGB(127, 247, 121)
'outputWksht2.Cells.EntireColumn.Font.Name = "Arial Unicode MS"
outputWksht.Cells.EntireColumn.HorizontalAlignment = xlCenter
'outputWksht2.Range("I2:L" & outputRow - 1).HorizontalAlignment = xlLeft
outputWksht.Rows(1).Font.Bold = True
outputWksht.Rows(1).Font.Bold = True
outputWksht.Range("A1:BE1" & rownum).Borders.LineStyle = xlContinuous
outputWksht.Range("A1:BE1" & rownum).Borders.Weight = xlThin
outputWksht.Cells.EntireColumn.AutoFit
Application.DisplayAlerts = True
Application.StatusBar = "Report is being created. Please wait....84% complete"
End Sub
我的代码从源文件获取所有数据我只需要特定的数据。任何帮助将不胜感激。
答案 0 :(得分：1)
你的代码中有很多重复，一些位置很好的数组会缩短它，header start和header end之间可以完全压缩到：
Range("A1:BD1").Formula = "-----"
Range("AS1:AU1").Formula = Array("Date of Data Extraction", "Priority Inspection", "Basis for Priority")
进一步向下循环行并执行公式，我想做一些优雅的事情，但问题是你的偏移量跳得太多而无法用数学方法完成，我想出了使用偏移阵列，我不要没有你的数据所以无法测试，但这应该可以替代整个大块：
lngLastRow = wksht1.Range("A" & wksht1.Rows.Count).End(xlUp).Row
'Using an offset array as below can either be a value for an offset command or you could use string references to column letters if you find it easier.
MyOffset = Array(2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 10, 10, 16, 16, 16, 17, 18, 18, 18, 18, 18, 29, 29, 33, 40, 40, 39, 39)
RowNum = 2
For Index = 2 To lngLastRow
For Y = LBound(MyOffset) To UBound(MyOffset)
outputWksht.Cells(RowNum, Y + 1).Value = wksht1.Cells(Index, RowNum).Offset(0, MyOffset(Y)).Value
Next
Dim varcluster As Variant
我已经在上方和下方留下了这条线，以便您可以看到替换代码的位置。您还需要将MyOffset作为变量Dim，将Y作为long。
再往下有一个以
开头的部分If Err = 0 Then
'from wksht4 = "mapping"
我没有更新这个，因为我认为你可能想要实现类似于我在上一节中展示的内容。
这会更新您现有的代码，使其更小，更容易修改，但它没有回答您的问题。要回答这个问题，我只需将该批次复制到新工作表中，过滤它然后删除带有null的行，然后删除这样的过滤器（在您发布的示例中完美运行）：
Sub DelStuff()
ActiveSheet.Copy
Selection.AutoFilter
ActiveSheet.Range("$A$1:$C$8").AutoFilter Field:=3, Criteria1:="="
ActiveSheet.Range("$A$1:$C$8").Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Selection.AutoFilter
End Sub
编辑：
您可以将新的标题代码压缩为：
outputWksht.Range("A1:BD1").Formula = Array("OrdStatus", "OrdNo", "RefNo", "FixCode", "FixDescription", "FindCode", "FindDescription", _
"FaultCode", "FaultDescription", "SvcType", "OrdCrtDate", "CustAcNo", "CustomrName", "CustClassn", "NetSvcId", "InstStDate", "BillAddress", _
"InstAddress", "ContactName", "ContactNo", "FranArea", "FranDesc", "SimSn", "SimModel", "PhoneSn", "PhoneModel", "ModemSn", "ModemModel", _
"Node3GId", "BtsIdCDMA", "MDF", "CABINET", "CAB_d_st", "CAB_d_pr", "DP", "DP_e_pr", "DP_add", "CAB_add", "Contractor", "Cluster", "Region", _
"DLY_date", "COM_date", "AcvNotes", "Date of Data Extraction", "Priority Inspection", "Basis for Priority", "QA CONTRACTOR", _
"QA Contractor Type", "QA REGION", "QA REGIONAL AREA", "QA COS CLUSTER", "QA COS SUB AREA", "FO TEAM LEADER", "QA Team Leader", "QA Inspector")
答案 1 :(得分：1)
如果您使用的是MS Excel for Windows，只需使用Jet/ACE SQL Engine在主工作簿上运行SQL，该Wget - Exit Status将安装在.dll文件中的所有PC上（以及构建MS Access的引擎）。由于您只需要WHERE列上的Header3子句，因此无需循环。
下面的宏通过ADO与提供者OLEDB或驱动程序ODBC（已注释掉）连接到Jet / ACE，并将带有列名的查询结果输出到名为Repair Details的现有工作表。请务必在SQL语句中填写实际工作表名称SheetName$：
Sub RunSQL()
On Error GoTo ErrHandle
Dim conn As Object, rst As Object
Dim strConnection As String, strSQL As String
Dim i As Integer, fld As Object
Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
' Hard code database location and name
' strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
' & "DBQ=C\Path\To\Source\Workbook.xlsx;"
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source='C\Path\To\Source\Workbook.xlsx';" _
& "Extended Properties=""Excel 8.0;HDR=YES;"";"
strSQL = " SELECT [SheetName$].[Header1], [SheetName$].[Header2]," _
& " [SheetName$].[Header3]" _
& " FROM [SheetName$]" _
& " WHERE [SheetName$].[Header3] = 1;"
' Open the db connection
conn.Open strConnection
rst.Open strSQL, conn
' column headers
i = 0
Worksheets("Results").Range("A1").Activate
For Each fld In rst.Fields
ActiveCell.Offset(0, i) = fld.Name
i = i + 1
Next fld
' data rows
Worksheets("Repair Details").Range("A2").CopyFromRecordset rst
rst.Close
conn.Close
MsgBox "Successfully ran SQL query!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " = " & Err.Description, vbCritical
Exit Sub
End Sub