Excel VBA循環遍歷列和保存結果

Question

這對我來說有點難度

我有以下代碼，它的工作方式與我想要的類似。但我需要代碼循環瀏覽Sheet1 Column A並將值複製並粘貼到Sheet2（R1）然後循環瀏覽Sheet1列B並將每個值粘貼到Sheet2（I7），然後將工作表保存爲新的PDF文檔

見圖例如Excel工作表 example

Sub Macro2() 
' 
' Macro2 Macro 
' 

' 
    Sheets("Sheet1").Select 
    Range("A2").Select 
    Selection.Copy 
    Sheets("Sheet2").Select 
    Range("R1").Select 
    ActiveSheet.Paste 
    Application.CutCopyMode = False 
    With Selection.Font 
     .Name = "Calibri" 
     .Size = 20 
     .Strikethrough = False 
     .Superscript = False 
     .Subscript = False 
     .OutlineFont = False 
     .Shadow = False 
     .Underline = xlUnderlineStyleNone 
     .ThemeColor = xlThemeColorLight1 
     .TintAndShade = 0 
     .ThemeFont = xlThemeFontMinor 
    End With 
    Sheets("Sheet1").Select 
    Range("B2").Select 
    Selection.Copy 
    Sheets("Sheet2").Select 
    Range("I7").Select 
    ActiveSheet.Paste 
    Application.CutCopyMode = False 
    With Selection.Font 
     .Name = "Calibri" 
     .Size = 16 
     .Strikethrough = False 
     .Superscript = False 
     .Subscript = False 
     .OutlineFont = False 
     .Shadow = False 
     .Underline = xlUnderlineStyleNone 
     .ThemeColor = xlThemeColorLight1 
     .TintAndShade = 0 
     .ThemeFont = xlThemeFontMinor 
     Dim i As Integer 
    For i = 1 To 2 
    Next i 
ThisWorkbook.Sheets("Sheet2").Select 
ActiveSheet.ExportAsFixedFormat _ 
     Type:=xlTypePDF, _ 
     Filename:=ThisWorkbook.Path & "\" & CStr(i) & ".pdf", _ 
     Quality:=xlQualityStandard, _ 
     IncludeDocProperties:=True, _ 
     IgnorePrintAreas:=True, _ 
     OpenAfterPublish:=False 
    End With 
End Sub 

Answer 1

您可以使用下面的代碼來遍歷行和/或列，如果你在末尾添加下面的函數（以下實際分）相同的「模塊「您的子版位於。

sub yourcode 
    ThisWorkbook.Worksheets("worksheetX").range(col_letter(column_number) & rownumber).Value 
end sub 

Function col_letter(lngCol As Long) As String 'Sub nr_to_letter() 
Dim vArr 
vArr = Split(Cells(1, lngCol).Address(True, False), "$") 
col_letter = vArr(0) 
End Function 

而且它將COLUMN_NUMBER欄自動轉換爲列字母在.range("..

而下面的通用代碼檢測您的列的最後一行：

'Find the last used row in a Column: column B in this example 
    Dim LastRow As Long 
    sheets(name(Sheet)).Select 
    sheets(name(Sheet)).Activate 

    'MsgBox (Sheet) 
    With ActiveSheet 
     LastRow = .Cells(.Rows.count, "B").End(xlUp).Row 
    End With 

我通過查找學到了很多基礎知識

來源：基本問題的標準解決方案，我從偶然http://www.rondebruin.nl/

而且我覺得這個代碼可以執行你所需的任務：

Sub Macro2() 
' 
' Macro2 Macro 
' 

' 
Sheets("Sheet1").Select 
Range("A2").Select 

'detect last row in column A sheet1: 
Dim LastRow As Long 
Sheets("Sheet1").Select 
Sheets("Sheet1").Activate 

'MsgBox (Sheet) 
With ActiveSheet 
    LastRow_A = .Cells(.Rows.Count, "A").End(xlUp).Row 
End With 
MsgBox (LastRow_A) 

'here the function to convert column number to column letter is used: 
'Range(col_letter(1) & "2:A" & LastRow).Select 
MsgBox ("As you can see the function converts the index of the col_letter to a alphabetic letter: " & col_letter(1)) 

For loop_through_column_A = 2 To LastRow_A 
    Range(col_letter(1) & loop_through_column_A).Select 
    Selection.Copy 
    Sheets("Sheet2").Select 
    Range("R" & loop_through_column_A - 1).Select 'ensure it starts pasting at row 1 
    ActiveSheet.Paste 
    Application.CutCopyMode = False 
    With Selection.Font 
     .Name = "Calibri" 
     .Size = 20 
     .Strikethrough = False 
     .Superscript = False 
     .Subscript = False 
     .OutlineFont = False 
     .Shadow = False 
     .Underline = xlUnderlineStyleNone 
     .ThemeColor = xlThemeColorLight1 
     .TintAndShade = 0 
     .ThemeFont = xlThemeFontMinor 
    End With 
Next loop_through_column_A 

Sheets("Sheet1").Select 
Range("B2").Select 


'detect last row in column B sheet1: 
Dim LastRow_B As Long 
Sheets("Sheet1").Select 
Sheets("Sheet1").Activate 

'MsgBox (Sheet) 
With ActiveSheet 
    LastRow_B = .Cells(.Rows.Count, "B").End(xlUp).Row 
End With 
MsgBox (LastRow_B) 

'loop through column Sheet1 
For loop_through_column_B = 2 To LastRow_B 

    Range("B" & loop_through_column_B).Select 
    Selection.Copy 
    Sheets("Sheet2").Select 

    Range("I" & 5 + loop_through_column_B).Select 
    ActiveSheet.Paste 
    Application.CutCopyMode = False 
    With Selection.Font 
     .Name = "Calibri" 
     .Size = 16 
     .Strikethrough = False 
     .Superscript = False 
     .Subscript = False 
     .OutlineFont = False 
     .Shadow = False 
     .Underline = xlUnderlineStyleNone 
     .ThemeColor = xlThemeColorLight1 
     .TintAndShade = 0 
     .ThemeFont = xlThemeFontMinor 
    End With 

    'To save the pdf every iteration (after you have already completely iterated through column A in the first for-loop: 
    '"Insert here." 

Next loop_through_column_B 


'include this in the loop if you want to save the pdf every time you add a different pasted row where it says: "Insert here." 
ThisWorkbook.Sheets("Sheet2").Select 
ActiveSheet.ExportAsFixedFormat _ 
     Type:=xlTypePDF, _ 
     Filename:=ThisWorkbook.Path & "\" & CStr(i) & ".pdf", _ 
     Quality:=xlQualityStandard, _ 
     IncludeDocProperties:=True, _ 
     IgnorePrintAreas:=True, _ 
     OpenAfterPublish:=False 

End Sub 

'Here the following function IS used: 
Function col_letter(lngCol As Long) As String 'Sub nr_to_letter() 
Dim vArr 
vArr = Split(Cells(1, lngCol).Address(True, False), "$") 
col_letter = vArr(0) 
End Function