更新

Question

我非常熟悉数据透视表vlookup，但感觉这可以通过VBA完成。

以下是我要做的事情：

Sheet 1：带标题的数据表。 Sheet 2：使用特定外观和数据格式化的摘要表只能粘贴到从row 10开始的工作表中。

在sheet 2, B5中，有一个下拉列表，可让您选择名称。
我希望有人能够检查Sheet 2 B5中的值是否与Sheet 1 Column A匹配。
然后代码将返回到数据表（sheet 1）并检查column A是否与Sheet 2 B5匹配。
如果Sheet 2 B5匹配Sheet 1 Column A，请复制Sheet 1列B, C, D, E, H, I, J, K, L, M, N, R, S, T, U, V, W, X, Y，Sheet 2 B5值，INTO sheet 2从row 10开始。

其他说明 - Sheet 1中的格式无法复制到Sheet 2。我只需要内容。 - 运行代码的按钮位于sheet 2。（因此sheet 2是宏运行时的活动表）。

我的代码到目前为止......

Sub Report ()
Dim finalrow As Integer, i as Integer, name as String
Sheets("Sheet 2").Range("A10:N29").ClearContents
name = Sheets("Sheet 2").Range("B5").Value
For i = 2 To Sheets("Sheet 1").Range("B" & Rows.Count).End(xlUp).Row
If Cells(i, 1) = name Then
Range(Cells(i, 2), Cells(i, 25)).Select
Selection.Copy
Worksheets("Sheet 2").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.PasteSpecial xlPasteFormulasAndNumberFormats
End If
Next i
End Sub

但我一直在

运行时错误9.

Answer 1

运行时错误主要是由于未正确寻址单元格而发生的。如果使用显式编码，则不太可能出现这些错误，并且您的代码也很容易辨认。也可以使用评论。

Option Explicit

Sub Report ()

 'Declare variables
  Dim name as String
  Dim wsh1 As Worksheet, wsh2 As Worksheet
  Dim erow As Long, i as Long

 'Set the sheets
  Set wsh1 = ThisWorkbook.Worksheets("Sheet 1")
  Set wsh2 = ThisWorkbook.Worksheets("Sheet 2")

 'clean destination worksheet
  wsh2.Range("A10:N29").ClearContents

  name = wsh2.Range("B5").Value 'condition for copying

 'loop over reference sheet
  For i = 2 To wsh1.Range("B" & Rows.Count).End(xlUp).Row 

    'Check if the row meets the condition
    If wsh1.Cells(i, 1) = name Then 

      wsh1.Range(wsh1.Cells(i, 2), wsh1.Cells(i, 25)).Copy 'copy the row

      erow = wsh2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 'find last row in wsh2 

      wsh2.Cells(erow, 1).PasteSpecial xlPasteFormulasAndNumberFormats 'paste only values

    End If

  Next i

End Sub

更新

由于OP提到它应该总是在第10行，那么这比使用最后一行更好：

在代码的开头和for循环之外定义erow = 10。然后你的if-block应该是这样的：

If wsh1.Cells(i, 1) = name Then 'Check if the row meets the condition

  wsh1.Range(wsh1.Cells(i, 2), wsh1.Cells(i, 25)).Copy 'copy the row

  wsh2.Cells(erow, 1).PasteSpecial xlPasteFormulasAndNumberFormats 'paste only values

  erow = erow + 1

End If

EXCEL VBA - 将符合条件的列从一个工作表复制到格式化的工作表

1 个答案:

更新