我遇到了一个问题,我无法在循环中找出问题,以便将其分解为这些期望的结果。我不太擅长循环部分,但我几乎理解了这一点,我只需要有人对此部分给予启发。
样本数据:
工作簿1
A B C D E<--(header)
1 2 3 4 5
1.1 2.1 3.1 4.1 5.1
1.2 2.2 3.2 4.2 5.2
1.3 2.3 3.3 4.3 5.3
工作簿2
A B C D E<--(header)
Apple Boy Cat Dog Ele
Apple1 Boy1 Cat1 Dog1 Ele1
Apple2 Boy2 Cat2 Dog2 Ele2
Apple3 Boy3 Cat3 Dog3 Ele3
工作簿2中的需求输出:
A B C D E<--(header)
Apple Boy Cat Dog Ele
1 2 3 4 5
Apple1 Boy1 Cat1 Dog1 Ele1
1.1 2.1 3.1 4.1 5.1
Apple2 Boy2 Cat2 Dog2 Ele2
1.2 2.2 3.2 4.2 5.2
Apple3 Boy3 Cat3 Dog3 Ele3
1.3 2.3 3.3 4.3 5.3
这是我的代码。
Sub foo()
Dim x As Workbook
Dim y As Workbook
Dim X1 As Worksheet
Set x = Workbooks.Open("C:\Documents and Settings\DON\My Documents\testingmacro2.xlsx") <----Workbook 1
Set y = Workbooks.Open("C:\Documents and Settings\DON\My Documents\testingmacro3.xlsx") <----Workbook 2
Set X1 = x.Sheets(2) <----Workbook 1
Set Y1 = y.Sheets(1) <----Workbook 2
For i = 2 To 1000
If X1.Cells(i, 2) = "" Then
Exit For
End If
For j = 1 To 1000 Step 5 (this is the part where i am having problems to get the desires outcome)
If Y1.Cells(i, j).Value = "" Then
Exit For
Else
X1.Cells(i, j).Resize(, 5).Cut
i = i + 1
Y1.Range("A" & i).Insert xlShiftDown
End If
Next
Next
x.Close
y.Close True
End Sub
答案 0 :(得分:1)
您不需要VBA即可。
步骤1.在工作簿1和工作簿2中添加一个临时列
步骤2.将工作簿1和特殊粘贴复制到工作簿2中,并赋值为
步骤3.在工作簿2中对temp列进行排序,然后删除temp列
答案 1 :(得分:1)
您的路况不错,但有一些小错误。
Option Explicit
,这有助于防止印刷错误,声明遗漏等。例如。这样可以避免丢失Dim
的{{1}}声明Y1
),不仅无效,而且不必要。您可以检测到最后一个活跃使用的数据行。您不应该在2 To 1000
循环内执行i = i + 1
。默认情况下,在VBA for
循环中已经内置了自动增量(for
)。如果您要更改它,请使用++
循环的声明进行更改
例如for
(是for i = 1 To 1000 Step 2
)。在内部进行操作可能会导致很多意外结果,因此应在i = i + 2
循环中保留此行为,而您不能直接对其进行操作。
最后,您有Do While/Until
,然后是x.Close
,其中之一显然是无效的语法。
从技术上讲,这不是错误,而是一种良好的编码习惯。不要对工作簿使用模糊的变量名,例如y.Close True
对于工作表使用x
。特别是在其他人正在阅读的大型程序中,这将导致不必要的混乱。甚至更糟糕的是,即使是您自己,如果您将其检查4年。
现在是实际答案:
此假设在
x1
,tbl1
的{{1}}和(2-6)
的{{1}}的列tbl2
中起作用
(2-6)
答案 2 :(得分:0)
感谢@RawrPlus提供的解决方案,我确实修改了一些部分,以使其完全符合我的要求。这是我的答案。
Option Explicit
Private Sub table_to_table()
'Declaration
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set wb1 = Workbooks.Open("C:\Documents and Settings\lye.yan.nian\My Documents\testingmacro2.xlsx")
Set wb2 = Workbooks.Open("C:\Documents and Settings\lye.yan.nian\My Documents\testingmacro3.xlsx")
Set ws1 = wb1.Sheets("Test2")
Set ws2 = wb2.Sheets("Test1")
Dim res_lr As Long
Dim lr2 As Long
lr2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row
Dim copyrange As Range
Dim i As Long
For i = 2 To lr2
'Set copyrange = ws2.Range(Cells(i, 2), Cells(i, 6))
Set copyrange = ws2.Range(ws2.Cells(i, 1), ws2.Cells(i, 5))
copyrange.Copy
res_lr = ws2.Cells(Rows.Count, 8).End(xlUp).Row
MsgBox res_lr
ws2.Range(Cells(res_lr + 1, 8), Cells(res_lr + 1, 12)).PasteSpecial xlPasteValues /* This is the part where i make changes */
'Set copyrange = ws1.Range(Cells(i, 2), Cells(i, 6))
Set copyrange = ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, 5))
copyrange.Copy
ws2.Range(Cells(res_lr + 2, 8), Cells(res_lr + 2, 12)).PasteSpecial xlPasteValues /* This is the part where i make changes */
Next i
wb1.Close
End Sub