Excel根据条件复制列

时间:2015-07-21 15:33:23

标签: excel vba

您好我有一个电子表格,我需要提取一些数据并将其复制到新工作表。

下面是电子表格的图片。我想要的是当M& M列列出的新表中所有黄色突出显示列的副本。列N包含数字(在这种情况下,只有2个将在第二个第7行和第26行)。这张表非常大,所以这只是一个样本。

enter image description here

Here is the code I have tried to use:

    Sub CopyYesAdrian()
Dim a As Variant, o As Variant
Dim i As Long, j As Long, n As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")
  a = .Cells(1, 1).CurrentRegion
  n = Application.CountIf(.Columns(9), "Yes")
  ReDim o(1 To n + 1, 1 To 11)

End With
j = j + 1: o(j, 1) = "CORP ID": o(j, 2) = "Application ID"
o(j, 3) = "Orig - Country": o(j, 4) = "Network DDI": o(j, 5) = "PTT ACCESS": 
  o(j, 6) = "TERM - COUNTRY": o(j, 7) = "TERM SW/TRUNK"
: o(j, 8) = "TERM DIGITS": o(j, 9) = "PSTN ROUTE": o(j, 10) = "PLAN": o(j,  
11) = "DNIS"
For i = 2 To UBound(a, 1)
If IsError(a(i, 6)) Then

 ElseIf a(i, 8) = "Yes" And a(i, 6) Like "[0-9][0-9][0-9][/][0-9]*" Then
    j = j + 1: o(j, 1) = a(i, 1): o(j, 2) = a(i, 3)
    o(j, 3) = a(i, 4): o(j, 4) = a(i, 6): o(j, 5) = a(i, 8):  o(j, 6) = a(i,   
9):  o(j, 7) = a(i, 10):  o(j, 8) = a(i, 11)
:   o(j, 9) = a(i, 12):   o(j, 10) = a(i, 12):   o(j, 11) = a(i, 12)
  End If
Next i
With Sheets("Sheet2")
  .UsedRange.Clear
  .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .UsedRange.Columns.AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

2 个答案:

答案 0 :(得分:0)

用以下代码替换多语句行:

j = j + 1
o(j, 1) = "CORP ID"
o(j, 2) = "Application ID"
o(j, 3) = "Orig - Country"
o(j, 4) = "Network DDI"
o(j, 5) = "PTT ACCESS"
o(j, 6) = "TERM - COUNTRY"
o(j, 7) = "TERM SW/TRUNK"
o(j, 8) = "TERM DIGITS"
o(j, 9) = "PSTN ROUTE"
o(j, 10) = "PLAN"
o(j, 11) = "DNIS"
For i = 2 To UBound(a, 1)
If IsError(a(i, 6)) Then

 ElseIf a(i, 8) = "Yes" And a(i, 6) Like "[0-9][0-9][0-9][/][0-9]*" Then
    j = j + 1
    o(j, 1) = a(i, 1)
    o(j, 2) = a(i, 3)
    o(j, 3) = a(i, 4)
    o(j, 4) = a(i, 6)
    o(j, 5) = a(i, 8)
    o(j, 6) = a(i, 9)
    o(j, 7) = a(i, 10)
    o(j, 8) = a(i, 11)
    o(j, 9) = a(i, 12)
    o(j, 10) = a(i, 12)
    o(j, 11) = a(i, 12)
End If

请尝试这个并告诉我它是否有效。

答案 1 :(得分:0)

这可以在没有VBA的情况下完成(在某种程度上)。

  • 在工作表2中输入以下公式,单元格A2: =IF(AND(ISNUMBER(Sheet1!$M2),ISNUMBER(Sheet1!$N2)),Sheet1!I2,"")

  • 将此公式复制/粘贴到单元格B2:H2。

  • 删除C列(它指的是Sheet1中的K列,您不希望这样)。
  • 选择整行公式并向下复制与图1中的行数相同的行。

这会让你尽可能地在问题中提出问题,但我假设你想从那里整理出空行。在这种情况下,您可能希望将Sheet2放入表中,以便过滤掉空行。