举个例子,我现在有一个excel工作薄,里面有两个sheet(我暂且命名为sheet1和sheet2)sheet1有数据;sheet2无数据,其中我想从sheet1中列头与sheet2列头相同的数据拷贝到sheet2下,如果对应不了的就不理会。。。不知道表达清楚没有!
小弟杠杠学习VBA,劳烦哪位大师帮我解决下这个问题,不甚感激!!!
人工核对编程,每一列写一条代码,例如,这个语句把sheet1表的A列拷贝到sheet2表的A列:
Sheets("sheet1").Range("A:A").Copy Sheets("sheet2").Range("A:A")
下面的语句同时拷屏A、B两列:
Sheets("sheet1").Range("A:B").Copy Sheets("sheet2").Range("A:B")
下面的语句把sheet1表的C列(单位名称)拷贝到sheet2表的D列:
Sheets("sheet1").Range("C:C").Copy Sheets("sheet2").Range("D:D")追问
Dim i, j
For i = 1 To Sheet2.UsedRange.Columns.Count
For j = 1 To Sheet1.UsedRange.Columns.Count
If Sheet1.Cells(1, i) = Sheet2.Cells(1, j) Then
Sheet1.Columns(i).Copy Sheet2.Columns(j)
Exit For
End If
Next j
Next i
End Sub追问
Sheets("sheet1").Range("A:A").Copy Sheets("sheet2").Range("A:A")
下面的语句同时拷屏A、B两列:
Sheets("sheet1").Range("A:B").Copy Sheets("sheet2").Range("A:B")
下面的语句把sheet1表的C列(单位名称)拷贝到sheet2表的D列:
Sheets("sheet1").Range("C:C").Copy Sheets("sheet2").Range("D:D")追问
人工核对太麻烦啊,数据量大这个还是不好操作哦
追答完全符合你的要求,测试通过的代码:
Sub xxx()Dim i, j
For i = 1 To Sheet2.UsedRange.Columns.Count
For j = 1 To Sheet1.UsedRange.Columns.Count
If Sheet1.Cells(1, i) = Sheet2.Cells(1, j) Then
Sheet1.Columns(i).Copy Sheet2.Columns(j)
Exit For
End If
Next j
Next i
End Sub追问
可以了,太谢谢了!
追答可用就行。麻烦点一下“采纳”~
追问不行是什么意思?能否拷屏,你的代码,执行的状态。
温馨提示:答案为网友推荐,仅供参考
第1个回答 2014-10-21
Sub findred()
Set xxx = Sheet1.UsedRange
For t1 = 1 To xxx.Rows.Count
For t2 = 1 To xxx.Columns.Count
If xxx(t1, t2).Font.ColorIndex = 3 Then
r = r + 1
Sheet2.Cells(r, 1).Resize(1, xxx.Columns.Count) = xxx.Rows(t1).Value
Exit For
End If
Next
Next
End Sub
--------------------------------------------------
根据补充, 再写以下一段程序:
Sub findempty()
Set xxx = Sheet1.[A3:A10000]
Set yy = Sheet2.[A3]
For Each xx In xxx
If Not IsEmpty(xx) Then
yy.Offset(r, 0) = xx
yy.Offset(r, 1) = xx.Offset(0, 3)
r = r + 1
End If
Next
End Sub
此程序差不多是VBA最基本及最低程度的代码, 亦容易明白及修改单元格的范围
Set xxx = Sheet1.UsedRange
For t1 = 1 To xxx.Rows.Count
For t2 = 1 To xxx.Columns.Count
If xxx(t1, t2).Font.ColorIndex = 3 Then
r = r + 1
Sheet2.Cells(r, 1).Resize(1, xxx.Columns.Count) = xxx.Rows(t1).Value
Exit For
End If
Next
Next
End Sub
--------------------------------------------------
根据补充, 再写以下一段程序:
Sub findempty()
Set xxx = Sheet1.[A3:A10000]
Set yy = Sheet2.[A3]
For Each xx In xxx
If Not IsEmpty(xx) Then
yy.Offset(r, 0) = xx
yy.Offset(r, 1) = xx.Offset(0, 3)
r = r + 1
End If
Next
End Sub
此程序差不多是VBA最基本及最低程度的代码, 亦容易明白及修改单元格的范围