繁体   English   中英

使用VBA在Excel中复制单元格

[英]Copy cells in excel with 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吗?

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

除了尝试调试您的代码外,我将向您提供有关如何调试此类内容的提示。

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

很难调试,因为他们试图做太多事情。 您有4个点运算符实例,并怀疑问题出在最后一个(.Copy)。 问题几乎可以肯定是您的代码没有抓住您认为它正在抓住的范围。 换句话说,本行前面的一个或多个方法调用需要调试。 在这种情况下,引入一些范围变量,将它们设置为各种值并将其地址打印到立即窗口以查看正在发生的情况很有用。 另一个好处是,设置范围变量可让您在VBA编辑器中充分利用智能。 就像是:

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

需要删除。 我删除行时必须将列向左移。

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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM