[英]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.