Excel VBA循环遍历列和保存结果

这对我来说有点难度

我有下面的代码，就像我想要的那样工作。 但我需要代码循环通过Sheet1列A并将值复制并粘贴到Sheet2（R1）然后循环通过Sheet1列B并复制每个值粘贴到Sheet2（I7），然后将工作表保存为一个新的PDF文档

请参阅图片，例如excel表格示例

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 

通过查找标准的解决scheme，我学到了很多的基础知识，我偶然发现了一些基本的问题：

来源： 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