我刚开始使用VBA,我正试着玩一下,看看我能做些什么。
我正在尝试编写一个宏,从主工作表上的数据子部分自动生成报告。
我想只复制列D中的值为"China"且H列中的值为"HS">. 此外,我只希望从选择的行(a:C,E,F,G,I,Q,R,AF:AH,AN,AP,AQ)复制数据。
到目前为止,我是这样做的:- 新建工作表
- 复制标题行
- 查找相关数据并复制/粘贴到新表格
根据我在这里和其他论坛找到的一些答案,我整理了以下内容。上半部分工作得很好(生成表格和复制标题行),但主要的重要部分没有。
如果这是一个科学怪人的工作请原谅我,我是新来的,但正在努力学习!
Option Explicit
Sub GenerateHSReport()
'Generating the sheet'
Sheets.Add(Count:=1).Name = "HS Report " & Format(Date, "DD-MM-YY")
'Adding the title row'
Sheets("SANBI - all bids").Range("A4:C4,E4,F4,G4,I4,Q4,R4,AF4:AH4,AN4,AP4,AQ4").Copy
Sheets("HS Report " & Format(Date, "DD-MM-YY")).Activate
Range("A1").Select
ActiveSheet.Paste
'Copying the HS data'
Dim srchtrm As String
Dim rng As Range, destRow As Long
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim c As Range
Dim i As Integer
With Application
.ScreenUpdating = False
.DisplayStatusBar = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set shtSrc = Sheets("SANBI - all bids")
Set shtDest = Sheets("HS Report " & Format(Date, "DD-MM-YY"))
Set c = Range("A5:C5,E5,F5,G5,I5,Q5,R5,AF5:AH5,AN5,AP5,AQ5")
destRow = 2
Set rng = Application.Intersect(shtSrc.Range("D:D, H:H"), shtSrc.UsedRange)
For Each c In rng.Cells
If c.Value = "HS" And c.Value = "China" Then
c.Copy shtDest.Cells(destRow, 2)
destRow = destRow + 1
End If
Next
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Application.CutCopyMode = False
End Sub
谢谢评论,它有效!多么令人兴奋啊!仅供参考,我必须为我想复制的每一列添加一行,如下所示。也许它有点乱,但它似乎工作!
shtDest.Cells(destRow, 1).Value = Row.Columns("a").Value
shtDest.Cells(destRow, 2).Value = Row.Columns("b").Value
shtDest.Cells(destRow, 3).Value = Row.Columns("c").Value
'...etc'
我在用手机,所以我现在不能测试,但它应该会指引你正确的方向
Set rng = shtSrc.UsedRange
Dim row as range
For Each row In rng.rows
If row.columns("h").value = "HS" And row.columns("d").value = "China" Then
shtDest.Cells(destRow, 2).value = Row.columns("b").value
destRow = destRow + 1
End If
Next
类似的东西,你明白了,它没有被测试