簡體   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