首页 > 解决方案 > 如何将计算数据(每月平均)从源工作簿传输到我的主工作簿?

问题描述

我有一个主工作簿,其中包含文件浏览器用户表单和表1中的图表以及表 2中图表的数据。

现在的想法是通过主工作簿中的文件浏览器搜索源工作簿,并将源工作簿中的相关数据传输到主工作簿表2中。

我需要的数据基本上是每月平均值。我不确定如何将一个工作簿引用到另一个工作簿,以便源工作簿中的计算数据出现在我的主工作簿的表 2中?

总结

我基本上需要下面看到的“传输按钮”的 vba 代码。

在此处输入图像描述

在此处输入图像描述

这是我到目前为止的代码:

浏览按钮

Private Sub CommandButton1_Click()
    Dim fNames As Variant
    With Me
        fNames = Application.GetOpenFilename("Excel File(s) (*.xls*),*.xls*", , , , True)
        If IsArray(fNames) Then .ListBox1.List = fNames
    End With
End Sub

平均每月计算

Sub Button1_Click()

Dim K As Double, Kn As Integer

Dim L As Double, Ln As Integer

Dim G As Double, Gn As Integer

Dim i As Integer, lastRow As Integer



lastRow = Cells(Rows.Count, 1).End(xlUp).Row



For i = 1 To lastRow

Select Case Range("H" & i)

Case "01.February"

K = K + Range("A" & i)

Kn = Kn + 1

Case "01.March"

L = L + Range("A" & i)

Ln = Ln + 1

Case "01.April"

G = G + Range("A" & i)

Gn = Gn + 1

End Select

Next i



Range("K1").Value = "February 2019"

Range("K2").Value = K / Kn

Range("L1").Value = "March 2019"

Range("L2").Value = L / Ln


End Sub

标签: excelvba

解决方案


由于您只选择一个文件,因此将 listBox 更改为 textBox

Option Explicit

Private Sub CommandButton1_Click() ' select file

    Dim fname As Variant
    With Me
        fname = Application.GetOpenFilename("Excel File(s) (*.xls*),*.xls*", , "Select FIle", , False)
        If fname <> "False" Then .TextBox1.Text = fname
    End With
End Sub


Private Sub CommandButton2_Click() ' update averages

    Const YEAR = 2019

    ' open source workbook
    Dim fname As String, wbSource As Workbook, wsSource As Worksheet
    fname = Me.TextBox1.Text

    If Len(fname) = 0 Then
       MsgBox "No file selected", vbCritical, "Error"
       Exit Sub
    End If

    Set wbSource = Workbooks.Open(fname, False, True) ' no link update, read only
    Set wsSource = wbSource.Sheets("Sheet1") ' change to suit

    Dim wb As Workbook, ws As Worksheet
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Table 2") '

    ' scan down source workbook calc average
    Dim iRow As Integer, lastRow As Integer
    Dim sMth As String, iMth As Integer
    Dim count(12) As Integer, sum(12) As Integer

    lastRow = wsSource.Cells(Rows.count, 1).End(xlUp).Row
    For iRow = 1 To lastRow

        If IsDate(wsSource.Cells(iRow, 8)) _
            And IsNumeric(wsSource.Cells(iRow, 1)) Then

            iMth = Month(wsSource.Cells(iRow, 8))   ' col H
            sum(iMth) = sum(iMth) + wsSource.Cells(iRow, 1) ' Col A
            count(iMth) = count(iMth) + 1 '

        End If
    Next

    ' close source worbook no save
    wbSource.Close False

    ' update Table 2 with averages
    With ws.Range("A3")
    For iMth = 1 To 12
        .Offset(0, iMth - 1) = MonthName(iMth) & " " & YEAR
        If count(iMth) > 0 Then
            .Offset(1, iMth - 1) = sum(iMth) / count(iMth)
            .Offset(1, iMth - 1).NumberFormat = "0.0"
        End If
    Next
    End With

    Dim msg As String
    msg = iRow - 1 & " rows scanned in " & TextBox1.Text
    MsgBox msg, vbInformation, "Table 2 updated"

End Sub


推荐阅读