Question

我希望你能帮助我，为更新按钮创建一个代码。我想要一个工作簿 - 输入数据，当我感觉到工作簿，然后单击更新按钮时，它将根据工作簿文件自动更新特定工作簿。在EnterData工作簿中提到。

EG。我想使用以下详细信息创建EnterData。

ITEMNAME：商品数量：

部门：每月3个部门工作表名称：月份 FileName：取决于ItemName

一旦我点击更新按钮，它将自动使用特定工作表名称和部门

更新特定文件

希望你能帮助我。

Answer 1

这将使您获得良好的开端我尝试将要执行的工作分成简单，可读和逻辑的任务。

使用常量进行设置，例如：根目录，单元格引用，列引用我希望在模块的顶部看到这个

Public Const TartgetWorkBookName As String =＆＃34; C：\ Users \ SomeFolder \ Data.xlsm＆＃34; 公共Const TartgetWorkSheetName As String =＆＃34; Sheet3＆＃34; 公共Const TartgetTopLeftCellAddress As String =＆＃34; A1＆＃34;

这个埋藏在代码中的地方：

Dim TargetWorkBook As Workbook
Set TargetWorkBook = Application.Workbooks.Open("C:\Users\SomeFolder\Data.xlsm")
Set getTargetR1C1 = TargetWorkBook.Worksheets("Sheet3").Range("A1")

以下是我遵循的基本模式的草稿。这是一个有效的例子。

Option Explicit

    Const TartgetWorkBookName As String = "C:\Users\SomeFolder\Data.xlsm"
    Const TartgetWorkSheetName As String = "Sheet3"
    Const TartgetTopLeftCellAddress As String = "A1"

    Dim TargetWorkBook As Workbook
    Set TargetWorkBook = Application.Workbooks.Open(TartgetWorkBookName)
    Set getTargetR1C1 = TargetWorkBook.Worksheets(TartgetWorkSheetName).Range(TartgetTopLeftCellAddress)

Sub PostRecord()
    Dim TargetR1C1 As Range, ItemName As String, Qty As Double, Department As String, Month_ As Integer
    Set TargetR1C1 = getTargetR1C1()

    'If your transfering a lot of data turn off
    Speedboost True
    '------Begin Loop
    '------For x = 2 to LastColumn
    '------Set Variables
    ItemName = "Dragon Sauce"
    Qty = 3
    Department = "Spicy Hot Stuff"
    Month_ = Month(Date)

    '------Post Varibles to taget
    UpdateRecord TargetR1C1, ItemName, Qty, Department, Month_

    'Next
    'Turn Everything back on
    Speedboost False
End Sub

Sub UpdateRecord(TargetR1C1 As Range, ItemName As String, Qty As Double, Department As String, Month_ As Integer)
    Dim c As Range
    Dim x As Long, y As Long
    If Len(TargetR1C1.Offset(1)) Then
        x = TargetR1C1.End(xlDown).Row + 1
    Else
        x = TargetR1C1.Rows + 1
    End If
    y = TargetR1C1.Column

    Set c = TargetR1C1.Cells
    c(x, y) = ItemName
    c(x, y + 1) = Qty
    c(x, y + 2) = Department
    c(x, y + 3) = Month_

End Sub

Sub Speedboost(bSpeedUpMacros As Boolean)
    With Application
        .ScreenUpdating = Not (bSpeedUpMacros)
        .EnableEvents = Not (bSpeedUpMacros)
        If bSpeedUpMacros Then
            .Calculation = xlCalculationManual
        Else
            .Calculation = xlCalculationAutomatic
        End If
    End With
End Sub

Function getTargetR1C1() As Range
    Dim TargetWorkBook As Workbook
    Set TargetWorkBook = Application.Workbooks.Open(TartgetWorkBookName)
    Set getTargetR1C1 = TargetWorkBook.Worksheets(TartgetWorkSheetName).Range(TartgetTopLeftCellAddress)
End Function

如何将一个Excel工作簿中的多个数据传输到另一个Excel工作簿

1 个答案: