Как перенести рассчитанные данные (среднее значение за месяц) из исходной рабочей книги в мою основную рабочую книгу? - PullRequest
0 голосов
/ 22 марта 2020

У меня есть главная рабочая книга с пользовательской формой файлового браузера и диаграммой в tabel 1 и данными для диаграммы в таблице 2 .

Теперь идея состоит в том, чтобы найти исходную рабочую книгу через файловый браузер в главной рабочей книге и перенести соответствующие данные из исходной рабочей книги в таблицу 2. из основной рабочей книги .

Мне нужны в основном средние данные за месяц. Я не уверен, как ссылаться на одну рабочую книгу на другую, чтобы вычисленные данные из исходной рабочей книги 1020 * появлялись в таблице 2 моей основной рабочей книги ?

Суммировано :

  • Основная рабочая книга (Рабочая тетрадь 1): отображение диаграммы, основанной на данных из Рабочей книги 2.

  • Исходная рабочая книга (Рабочая тетрадь 2): предоставляет необходимые данные.

Мне в основном нужен код vba для кнопки передачи "видно ниже.

enter image description here

enter image description here

Это код, который я имею до сих пор:

Кнопка просмотра

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

1 Ответ

1 голос
/ 22 марта 2020

Поскольку вы выбираете только один файл, измените 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

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...