复制Excel中的单元格与VBA

我有一个代码,从文本文件中读入新的列排列,然后通过将原始列复制到正确的位置来重新排列原始列,但是在我的代码中存在一个错误。 而不是只复制1列,似乎将所有列复制到我想要复制的列的右侧。

所以我想错误在这里

'copy the old range ws.Range(ws.Cells(Settings.rowHeader + 1, CounterCol), ws.Cells(lrow, CounterCol)).Copy 

我想复制范围AW3:AW80到A3:A80,但是我需要将AW:AW复制到A:A吗? 如果我这样做,行1中的东西将被删除,下面是完整的代码:

  Sub insertColumns() Call Settings.init Dim i As Integer Dim ws As Worksheet Dim lrow As Integer Dim columNames As Object Dim temp As Variant 'fill dictionary with columnnames from text file Set columNames = FileHandling.getTypes(Settings.columnFile) Set ws = ActiveWorkbook.Sheets("List") 'Get max column and row number lColumn = HelpFunctions.getLastColumn(ws, Settings.rowHeader) lrow = HelpFunctions.getLastRow(ws, HelpFunctions.getColumn("*part*", ws, Settings.rowHeader)) 'Insert all new columns in reverse order from dictionary temp = columNames.keys For i = columNames.Count - 1 To 0 Step -1 ws.Columns("A:A").Insert Shift:=xlToRight ws.Range("A" & Settings.rowHeader).Value = temp(i) Next i 'last column lastColumn = lColumn + columNames.Count 'we loop through old cells CounterCol = columNames.Count + 1 Do While CounterCol <= lastColumn j = 0 'through each elemnt in dictionary For Each element In temp j = j + 1 'compare the old rowheader with any of the rowheader in DICTIONARY If UCase(ws.Cells(Settings.rowHeader, CounterCol).Value) = element Then 'copy the old range ws.Range(ws.Cells(Settings.rowHeader + 1, CounterCol), ws.Cells(lrow, CounterCol)).Copy 'paste it ws.Cells(Settings.rowHeader + 1, j).Select ws.Paste 'format the new row ws.Cells(Settings.rowHeader + 1, j).EntireColumn.AutoFit 'Delete the old row ws.Columns(CounterCol).EntireColumn.Delete 'decrease the last column by one since we just deleted the last column lastColumn = lastColumn - 1 found = True 'Exit For End If Next element 'Prompt the user that the old column does not match any of the new column If Not found Then MsgBox (UCase(ws.Cells(Settings.rowHeader, CounterCol)) & " was not a valid column name please move manually") End If 'reset the found found = False 'go to nect column CounterCol = CounterCol + 1 Loop End Sub 

以下是字典的截图。 字典

在第一次迭代/第一次复制之后,它应该只复制在零件号码列上,但是可以看到它已经复制了不止是第一列(除了图号)

在这里输入图像描述

问:我想复制范围AW3:AW80到A3:A80,但是我需要将AW:AW复制到A:A吗?

答:不可以。可以复制任何范围。

而不是试图debugging你的代码,我会给你一个关于如何debugging这样的事情的提示。 线条喜欢

 ws.Range(ws.Cells(Settings.rowHeader + 1, CounterCol), ws.Cells(lrow, CounterCol)).Copy 

很难debugging,因为他们试图做太多。 你有4个点运算符的实例,怀疑是最后一个问题(.Copy)。 问题几乎可以肯定的是,你的代码并没有抓住你认为正在抓取的范围。 换句话说,行中的一个或多个方法调用需要debugging。 在这种情况下,引入一些范围variables,将它们设置为等于各种值并将其地址打印到即时窗口以查看发生的事情是有用的。 作为一个额外的好处,设置范围variables允许您在VBA编辑器中使用intellisence的全部function。 就像是:

 Dim SourceRange As Range, Cell1 As Range, Cell2 As Range ' ' ' Set Cell1 = ws.Cells(Settings.rowHeader + 1, CounterCol) Set Cell2 = ws.Cells(lrow, CounterCol) Set SourceRange = ws.Range(Cell1, Cell2) Debug.Print Cell1.Address & ", " & Cell2.Address & ", " & SourceRange.Address ' 'Once the above is debugged: ' SourceRange.Copy 'should work as expected 

您可能正在复制要复制的范围,但是较大的程序仍然无法正常工作。 在这种情况下,你有某种逻辑错误,应该试图复制其他范围。 即使如此,上述练习仍然有帮助,因为它清楚地说明了你的原始线路在做什么。

  'go to nect column CounterCol = CounterCol + 1 

需要删除。 它必须这样做,当我删除行的列左移。

谢谢您的帮助。 我希望代码可以用于其他需要添加列的人,但仍然按照正确的顺序复制旧列中的内容。