我有点像新手VBA用户,我创建了一个具有多个标签的Userform的工作簿。当用户选择适当的选项卡并输入数据时,它将被传输到适用的工作表。我在工作表上有一个命令按钮,单击它时会提示输入日期范围,然后我希望它从每个适用的工作表中提取传输的数据,并将其放在每个用户的单独的新工作表中(因为每个人的数据都是不同)。我编译的以下VBA代码未正确处理。相反,它只从一个工作表中提取数据并将其放在所有新的单个工作表上。
Sub Copy_Click()
Dim startdate As Date, enddate As Date
Dim rng As Range, destRow As Long
Dim shtSrc1 As Worksheet
Dim shtSrc2 As Worksheet
Dim shtSrc3 As Worksheet
Dim shtDest1 As Worksheet
Dim shtDest2 As Worksheet
Dim shtDest3 As Worksheet
Dim c As Range
Set shtSrc1 = Sheets("Recruiter")
Set shtSrc2 = Sheets("SrRecruiter")
Set shtSrc3 = Sheets("RecruiterSpc")
Set shtDest1 = Sheets("Extract_Recrt")
Set shtDest2 = Sheets("Extract_SrRecrt")
Set shtDest3 = Sheets("Extract_RecrtSpc")
destRow = 2 'start copying to this row
startdate = CDate(InputBox("Input desired start date for report data"))
enddate = CDate(InputBox("Input desired end date for report data"))
'don't scan the entire column...
Set rng = Application.Intersect(shtSrc1.Range("A:A"), shtSrc1.UsedRange)
Set rng = Application.Intersect(shtSrc2.Range("A:A"), shtSrc2.UsedRange)
Set rng = Application.Intersect(shtSrc3.Range("A:A"), shtSrc3.UsedRange)
For Each c In rng.Cells
If c.Value >= startdate And c.Value <= enddate Then
c.Offset(0, 0).Resize(1, 25).Copy _
shtDest1.Cells(destRow, 1)
c.Offset(0, 0).Resize(1, 25).Copy _
shtDest2.Cells(destRow, 1)
c.Offset(0, 0).Resize(1, 25).Copy _
shtDest3.Cells(destRow, 1)
destRow = destRow + 1
End If
Next
End Sub
任何人都可以告诉我我做错了什么以及如何解决它。
答案 0 :(得分:1)
首先看起来你正在设置rng
变量,然后覆盖它。
我会将代码更改为类似的内容,以容纳似乎需要的3个rng
变量。
即
Dim rng(1 To 3)
Set rng(1) = Application.Intersect(shtSrc1.Range("A:A"), shtSrc1.UsedRange)
Set rng(2) = Application.Intersect(shtSrc2.Range("A:A"), shtSrc2.UsedRange)
Set rng(3) = Application.Intersect(shtSrc3.Range("A:A"), shtSrc3.UsedRange)
然后使用for loop
遍历您刚设置的每个范围。完整的代码如下所示。
Sub Copy_Click()
Dim startdate As Date, enddate As Date
Dim rng(1 To 3) As Range, destRow As Long
Dim shtSrc1 As Worksheet
Dim shtSrc2 As Worksheet
Dim shtSrc3 As Worksheet
Dim shtDest(1 To 3) As Worksheet
Dim c As Range
Set shtSrc1 = Sheets("Recruiter")
Set shtSrc2 = Sheets("SrRecruiter")
Set shtSrc3 = Sheets("RecruiterSpc")
Set shtDest(1) = Sheets("Extract_Recrt")
Set shtDest(2) = Sheets("Extract_SrRecrt")
Set shtDest(3) = Sheets("Extract_RecrtSpc")
destRow = 2 'start copying to this row
startdate = CDate(InputBox("Input desired start date for report data"))
enddate = CDate(InputBox("Input desired end date for report data"))
If IsDate(stardate) = False Then Exit Sub
'don't scan the entire column...
Set rng(1) = Application.Intersect(shtSrc1.Range("A:A"), shtSrc1.UsedRange)
Set rng(2) = Application.Intersect(shtSrc2.Range("A:A"), shtSrc2.UsedRange)
Set rng(3) = Application.Intersect(shtSrc3.Range("A:A"), shtSrc3.UsedRange)
For i = LBound(rng) To UBound(rng)
For Each c In rng(i).Cells
If c.Value >= startdate And c.Value <= enddate Then
c.Offset(0, 0).Resize(1, 25).Copy _
shtDest(i).Cells(destRow, 1)
destRow = destRow + 1
End If
Next
Next i
End Sub
答案 1 :(得分:0)
不太确定您的需求,但您可以试试这个
Option Explicit
Sub Copy_Click()
Dim startdate As Date, enddate As Date
Dim rng As Range, c As Range
Dim destRow(1 To 3) As Long
Dim shtSrc(1 To 3) As Worksheet
Dim shtDest(1 To 3) As Worksheet
Dim i As Long
Set shtSrc(1) = Sheets("Recruiter")
Set shtSrc(2) = Sheets("SrRecruiter")
Set shtSrc(3) = Sheets("RecruiterSpc")
Set shtDest(1) = Sheets("Extract_Recrt")
Set shtDest(2) = Sheets("Extract_SrRecrt")
Set shtDest(3) = Sheets("Extract_RecrtSpc")
destRow(1) = 2: destRow(2) = 2: destRow(3) = 2
startdate = CDate(InputBox("Input desired start date for report data"))
enddate = CDate(InputBox("Input desired end date for report data"))
For i = 1 To 3
Set rng = shtSrc(i).Range("A:A").SpecialCells(xlCellTypeConstants, xlNumbers) 'this will select only numbers constants. since dates are numbers they'll get into this range
For Each c In rng
If c.Value >= startdate And c.Value <= enddate Then
c.Offset(0, 0).Resize(1, 25).Copy Destination:=shtDest(i).Cells(destRow(i), 1)
destRow(i) = destRow(i) + 1
End If
Next c
Next i
End Sub