在Excel中记录了一个宏,我想更改代码中的某些内容

时间:2018-07-17 13:57:36

标签: excel vba excel-vba

我已经在Excel中记录了一个宏。 我在列中输入数据。之后,我希望该数据出现在其他位置。 我想重复此操作几次,我只希望数据始终显示在右侧。我知道应该有一个非常简单的解决方案,但是我对此很陌生。 如果我的信息不太清楚,请询问更多详细信息。 这是我到目前为止的代码:

Sub adding_another_trip()
'
' adding_another_trip Macro
' Use this macro to move this trip to the overview and add another trip
'

'
ActiveWindow.SmallScroll Down:=-6
Range("C2:C11").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=18
Range("C26").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-9
Range("H13").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=9
Range("C36").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-6
Range("I13").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=6
Range("C37").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


End Sub

这是对工作表的捕获。因此,上面的信息必须出现在概述中,然后,如果有人再次填写了上面的表,则它必须出现在行程2中。我希望这可以解决问题。 link capture sheet

1 个答案:

答案 0 :(得分:0)

这可以帮助您学习一些VBA并开始您的学习。 。 。

有很多方法可以完成您的工作,其中一个折皱是您复制的内容不是连续的范围,它可以是两个副本,第二个范围是粘贴在粘贴上的(列到行,或行到列)。 在制作数据输入表单时,这些表单可能会很大,并且需要验证范围。 。 。不过,这似乎很简单。

我没有格式化货币(欧元),并且在一些事情上用光了时间。 只是想在简单的设置中向您展示一些强大的工具,使这些工具看起来过于复杂,但这是学习真正可行的开始(我仍在学习)。

如果您学习此代码并在论坛(和互联网)上浏览,您将成为您所在部落的Excel专家。

Option Explicit

'You can make the Sub below Public if you want to run as a Macro
'Since it is a button and does not need any added scope, Private is fine
'Find the button Sub in your sheet, there is clearly a button on it
'Might want to add other buttons to clear the trip copy range and the trip sumamry/overview ranges

Private Sub CommandButton1_Click()

'Having a worksheet variable means less typing later
Dim ws As Worksheet

'This will be our looping variable to find the next open column
Dim i As Integer
'This will be out looping variable to fill in the rows
Dim j As Integer

'Define an Array to hold your copy values
Dim arrCopy(0 To 11) As Long

'Rather than hard code we will make variables for the rows to copy
'They won't cahnge unless you change your form
Dim rCopy1 As Double
Dim rCopy2 As Double
Dim rCopy3 As Double
Dim rCopy4 As Double
Dim rCopy5 As Double
Dim rCopy6 As Double
Dim rCopy7 As Double
Dim rCopy8 As Double
Dim rCopy9 As Double
Dim rCopy10 As Double

'Dim the sum rows we need at the end
Dim rNights As Double
Dim rCost As Double
Dim rTime As Double

'Rather than hard code we will make variables for the cols to copy
'They won't change unless you change your form
Dim cCopy1 As Double
Dim cCopy2 As Double
Dim cCopy3 As Double

'Declare some paste Variables
Dim rFirstPaste As Double
Dim cFirstPaste As Double
Dim cLastPaste As Double


'Intialiaze the variables, this is where changes would be made if you change the form
'Change the "Sheet1" to your sheet name, or name the sheets in Properties and skip this step forever
Set ws = ThisWorkbook.Worksheets("Sheet1")
rCopy1 = ws.Range("B3").Row 'The B is not what matters in these lines, its not a row
rCopy2 = ws.Range("B4").Row
rCopy3 = ws.Range("B5").Row
rCopy4 = ws.Range("B6").Row
rCopy5 = ws.Range("B7").Row
rCopy6 = ws.Range("B8").Row
rCopy7 = ws.Range("B9").Row
rCopy8 = ws.Range("B10").Row
rCopy9 = ws.Range("B11").Row
rCopy10 = ws.Range("B13").Row 'BTW - Two items in this row

rFirstPaste = ws.Range("C26").Row 'The C is not what matters in these lines, its not a row

rNights = ws.Range("C35").Row 'we will need these for the summary at the end
rCost = ws.Range("D36").Row
rTime = ws.Range("D37").Row

cCopy1 = ws.Range("B3").Column 'The # is not what matters in this line, its not a Column
cCopy2 = ws.Range("C13").Column
cCopy3 = ws.Range("D13").Column

cFirstPaste = ws.Range("C26").Column
cLastPaste = ws.Range("E26").Column

'Load the array the hard way
arrCopy(0) = ws.Cells(rCopy1, cCopy1).Value 'Flight, = ws.Cells(3,2) which is ws.Range("B3") in (row,col)
arrCopy(1) = ws.Cells(rCopy2, cCopy1).Value 'Train
arrCopy(2) = ws.Cells(rCopy3, cCopy1).Value 'Hotel
arrCopy(3) = ws.Cells(rCopy4, cCopy1).Value 'Rental Car
arrCopy(4) = ws.Cells(rCopy5, cCopy1).Value 'Taxi/metro
arrCopy(5) = ws.Cells(rCopy6, cCopy1).Value 'Per Diem
arrCopy(6) = ws.Cells(rCopy7, cCopy1).Value 'Internet
arrCopy(7) = 0 'We are going to skip this element in the loop
arrCopy(8) = ws.Cells(rCopy8, cCopy1).Value '# of Trips
arrCopy(9) = ws.Cells(rCopy9, cCopy1).Value '# of night per trip
arrCopy(10) = ws.Cells(rCopy10, cCopy2).Value '#Travel Cost per trip
arrCopy(11) = ws.Cells(rCopy10, cCopy3).Value '#Travel Time per trip

'Find the first open Column in the Overview Range
For i = cFirstPaste To cLastPaste + 1 'We traverse column 3 to 6, that is one past the boundary for error check

    If ws.Cells(rFirstPaste, i) = "" And i <= cLastPaste Then 'Is C26, D26, E26 empty? did we go too far F26

        'The Column stopped at the empty column and it is in our range, so fill it in
        For j = 0 To 11 'You have 12 paste rows, you skip #8 whic is 7 for us in zero based offset
            If j <> 7 Then 'If j does not equal 7, we are skipping this number
                ws.Cells(rFirstPaste + j, i) = arrCopy(j)
            Else ' Do Nothing
            End If
        Next j 'Add 1 to j

        'We have filled the paste range, this will break the loop
        i = 9999 'We are not searching 100,000 columns it is very out of bounds

        'Update the summary, shouldn't hard code these, there is a temptation on smaller forms
        ws.Range("C21") = WorksheetFunction.Sum(ws.Range("C35:E35"))
        ws.Range("D21") = WorksheetFunction.Sum(ws.Range("C36:E36"))
        ws.Range("E21") = WorksheetFunction.Sum(ws.Range("C37:E37"))
    Else
    End If
Next i 'Add 1 to i

'Test i to see if it is out of bounds, exception is our break loop (9999) + 1
If i > cLastPaste And i <> 10000 Then
    MsgBox "There is a 3 trip limit", vbExclamation, "ERROR: Trip Limit"
Else ' Do Nothing
End If


End Sub

快乐编码!

enter image description here