如何添加条件到我录制的macros?

我logging了下面这个macros,当我运行这个macros的时候,这个macros用于自动传输我input到一个工作表的数据到另一个工作表。 目前,我将不得不在本工作簿中为每个新工作表logging一个macros,并根据我需要传输新数据的表来运行每个单独的macros。 我想知道如何添加条件到这个macros,将自动决定哪些工作表来发送新的数据,基于什么文字在原始工作表的G列。 G列中可能包含四种不同的文本短语。任何帮助将不胜感激!

Sub over_90_days() ' ' over_90_days Macro ' transfer info from all terms to over 90 days sheet ' ' ActiveCell.Offset(0, -7).Columns("A:A").EntireColumn.Select Selection.End(xlDown).Select End Sub Sub update() ' ' update Macro ' move new data to a different worksheet ' ' Range("Table1[[#Headers],[Name, Last]]").Select Selection.End(xlDown).Select Range("A74:B74").Select Selection.Copy Sheets("90 DAYS OR LESS").Select Range("A2").Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Range("A1").Select ActiveSheet.Paste Sheets("ALL TERMS").Select ActiveCell.Offset(0, 2).Range("A1").Select Application.CutCopyMode = False Selection.Copy Sheets("90 DAYS OR LESS").Select ActiveCell.Offset(0, 2).Range("A1").Select ActiveSheet.Paste Sheets("ALL TERMS").Select ActiveCell.Offset(0, 1).Range("A1").Select Application.CutCopyMode = False Selection.Copy Sheets("90 DAYS OR LESS").Select ActiveCell.Offset(0, 1).Range("A1").Select ActiveSheet.Paste Sheets("ALL TERMS").Select ActiveCell.Offset(0, 2).Range("A1").Select Application.CutCopyMode = False Selection.Copy Sheets("90 DAYS OR LESS").Select ActiveCell.Offset(0, 1).Range("A1").Select ActiveSheet.Paste ActiveWindow.SmallScroll Down:=3 ActiveSheet.Paste Application.CutCopyMode = False ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove End Sub 

所以这是我的第二次那个光荣的尝试:

 Sub update() Set MainSheet = ThisWorkbook.Worksheets("ALL TERMS") Set Sheet1 = ThisWorkbook.Worksheets("TERM PRE OJT") Set Sheet2 = ThisWorkbook.Worksheets("TERM POST OJT") Set Sheet3 = ThisWorkbook.Worksheets("90 DAYS OR LESS") Set Sheet4 = ThisWorkbook.Worksheets("OVER 90 DAYS") Dim Rnge2 As Range Set Rnge2 = "A2" Dim i As Integer For i = 1 To 50 MyValue = MainSheet.Cells(i, 7).Value If MyValue = "orientation only" Then ActiveCell.Offset(0, -6).Select Range(ActiveCell, ActiveCell.Offset(0, 4)).Copy Sheet1.Select Rnge2.Select ActiveCell.Offset(1, 0).Select ActiveSheet.Paste ActiveCell.Offset(1, 0).Select 'move down one row ElseIf MyValue = "ojt only" Then ActiveCell.Offset(0, -6).Select Range(ActiveCell, ActiveCell.Offset(0, 4)).Copy Sheet2.Select Rnge2.Select ActiveCell.Offset(1, 0).Select ActiveSheet.Paste ActiveCell.Offset(1, 0).Select ElseIf MyValue = "90 days or less" Then ActiveCell.Offset(0, -6).Select Range(ActiveCell, ActiveCell.Offset(0, 4)).Copy Sheet3.Select Rnge2.Select ActiveCell.Offset(1, 0).Select ActiveSheet.Paste ActiveCell.Offset(1, 0).Select ElseIf MyValue = "over 90 days" Then ActiveCell.Offset(0, -6).Select Range(ActiveCell, ActiveCell.Offset(0, 4)).Copy Sheet1.Select Rnge2.Select ActiveCell.Offset(1, 0).Select ActiveSheet.Paste ActiveCell.Offset(1, 0).Select End If Next End Sub 

它不工作,我不知道为什么。

你可以select这样的表:

 dim MyWorksheet as Worksheet set MyWorksheet = ThisWorkbook.Worksheets("the name of the sheet you want") 

因此,您可以使用该表的名称将MyWorksheet设置为代码中所需的任何工作表:

 dim MyWorksheet1 as Worksheet set MyWorksheet1 = ThisWorkbook.Worksheets("the name a sheet") dim MyWorksheet2 as Worksheet set MyWorksheet2 = ThisWorkbook.Worksheets("the name of second sheet") 

现在,您可以在表单中获取任何单元格,例如:

 dim MyCell as Range, MyCell2 as Range, MyCell3 as Range set MyCell = MyWorksheet1.Range("G1") // gets G1 set MyCell2 = MyWorksheet1.Range("G:G") // gets the entire G column set MyCell3 = MyWorksheet1.Cells(2,2) // gets B2 

你可以看到单元格中的值是什么:

 MyCell.Value 

你可以设置一个单元格的值:

 MyCell.Value = "The Value I want" //a text MyCell.Value = 2 //a number MyCell.Value = MyCell2.Value //the value of another cell 

有了这个,你可以玩耍,创build你自己的代码,select你想要的单元格,并转移到你想要的表单上。

如果您不习惯编程,请在loopssearch教程, if statements ,请为VBA select case statements

所有那些出现在录制macros中的select都可以用上面展示的那些Range来replace,除非你真的想要得到选中的单元格,然后使用录制的select。

copypaste commands也可以用于上面的工作表。 但是有时候最好通过Range.Value代码来传递值(这样可以避免复制格式和forumlas,而且更快)。


一个例子:

MainSheet中的G列包含3行,我将它们复制到Sheet1或Sheet2取决于单元格中的值:

 dim MainSheet as Worksheet, Sheet1 as Worksheet, Sheet2 as Worksheet set MainSheet = ThisWorkbook.Worksheets("MainSheet") set Sheet1 = ThisWorkbook.Worksheets("The name of sheet1") set Sheet2 = ThisWorkbook.Worksheets("The name of sheet2") dim i as integer for i = 1 to 3 'this is a loop that will run three times with i from 1 to 3 dim MyValue as variant MyValue = MainSheet.Cells(i,7).Value 'i is the row / 7 is G 'check the value of a cell in row "i" and column G if MyValue = "the value I want to go to sheet 1" then Sheet1.Cells(i,7).Value = MyValue 'copy to sheet 1 same row and column, but you can change that else 'if value is not that one I expected Sheet2.Cells(i,7).Value = MyValue 'copy to sheet 2.... end if 'this ends the if part of the code next 'this ends the loop part of the code 

看看你的第二次尝试:

在你的情况下,我相信Set Rnge2 = "A2"是第一个问题。 Range是您必须从工作表中检索的对象: Set Rnge2 = MainSheet.Range("A2")

在代码中,我总是避免使用接口的方法,比如复制/粘贴和活动单元,这些方法很慢并且带来更多关注。

所以我build议你做以下几点:

 'this forces me to declare all vars. It's a personal preference 'this way I don't have any var with an unidentified type Option Explicit Sub update() 'declare every sheet because I used option explicit 'option explicit obliges that we declare everything, I prefer it this way to avoid having unknown vars in the code Dim MainSheet As Worksheet, Sheet1 As Worksheet, Sheet2 As Worksheet, Sheet3 As Worksheet, Sheet4 As Worksheet Set MainSheet = ThisWorkbook.Worksheets("ALL TERMS") Set Sheet1 = ThisWorkbook.Worksheets("TERM PRE OJT") Set Sheet2 = ThisWorkbook.Worksheets("TERM POST OJT") Set Sheet3 = ThisWorkbook.Worksheets("90 DAYS OR LESS") Set Sheet4 = ThisWorkbook.Worksheets("OVER 90 DAYS") Dim i As Integer Dim R1 As Integer, R2 As Integer, R3 As Integer, R4 As Integer Dim CurrentCell As Range Dim MyValue As String 'keeping one row per sheet in order to move down separately R1 = 2 'start row in sheet1 R2 = 2 'start row in sheet2 R3 = 2 'start row in sheet3 R4 = 2 'start row in sheet4 For i = 1 To 26 'Using a current cell in MainSheet, this will move down at the end of this loop Set CurrentCell = MainSheet.Cells(i, 7) 'Taking value from the current cell MyValue = LCase(CurrentCell.Value) If MyValue = "orientation only" Then 'Created a sub that avoids repeating all the code four times 'copies the row i from main sheet to row R1 in Sheet1 Call CopyTo(MainSheet, i, Sheet1, R1) R1 = R1 + 1 'move down one row' ElseIf MyValue = "ojt only" Then Call CopyTo(MainSheet, i, Sheet2, R2) R2 = R2 + 1 'move down one row' ElseIf MyValue = "90 days or less" Then Call CopyTo(MainSheet, i, Sheet3, R3) R3 = R3 + 1 'move down one row' ElseIf MyValue = "over 90 days" Then Call CopyTo(MainSheet, i, Sheet4, R4) R4 = R4 + 1 'move down one row' Else MsgBox "Cell G" & Trim(Str(i)) & " has an invalid value" End If 'move down the current cell in main sheet Set CurrentCell = CurrentCell.Offset(1, 0) Next End Sub Sub CopyTo(MainSheet As Worksheet, MainRow As Integer, TargetSheet As Worksheet, TargetRow As Integer) Dim LineValue As Variant 'take all values from cell "Ai" to "Ei" in MainSheet LineValue = MainSheet.Range(MainSheet.Cells(MainRow, 1), MainSheet.Cells(MainRow, 5)).Value 'puts this value in a same size range in target sheet TargetSheet.Range(TargetSheet.Cells(TargetRow, 1), TargetSheet.Cells(TargetRow, 5)).Value = LineValue End Sub