Excel VBA: найти - сравнить два файла - скопировать

Question

Я новичок в VBA, пробовал с 12 часовых кодов и не получил исправления. Я действительно надеюсь, что вы можете помочь мне!

У меня есть два Excel-файла. Например, это выглядит так: Входной файл1

Должен найти месяц через выпадающий список (январь , Февраль ....) и скопируйте указанные ниже c ячейки в Excel-файл 2 за январь, февраль ....

Кроме того, он должен найти слово, выбранное по выпадающему меню (KW1 , KW2, KW3, ....) и скопируйте значения ячеек в AB C DE в Excel-файле 2.

Как: Основной файл2

Excel-File 2 - это «Master-Excel», и с помощью кнопки «werte_uebergeben» вы можете отправлять значения из File1 (A1: A11) в File2 в (A1: A11) или (B1: B11) ... зависит в заголовке

С помощью кнопки «Страна» в File1 вы можете отправить строку для JP с ячейками (E25: I25) в File2 в (G28: K28) - зависит от слова KW1, KW2 (G35) : K35) или KW3 (G42: K42).

Я действительно надеюсь, что было бы немного яснее разобраться с фотографиями.

Вот фрагмент кода для 2n d Задание, но оно должно автоматически вставить его в строку с «KW1». Кроме того, он должен поставить в KW1, KW2 ... Я выбрал

Sub country_Click()
Dim wsIRow As Long, wsORow As Long
Dim wsI As Worksheet, wsO As Worksheet
Dim rng As Range, aCell As Range
Dim Kalenderwoche As String

Set wsI = ThisWorkbook.Sheets("Tabelle1")
Set wsO = Workbooks.Open("C:\Users\MM\\Mappe2.xlsx").Worksheets("Tabelle1")
Kalenderwoche = ThisWorkbook.Sheets("Tabelle1").Cells(1, 1).Value

wsORow = wsO.Cells.Find(What:="*", SearchOrder:=xlByRows, _
         SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

With wsI
    wsIRow = wsI.Cells.Find(What:="*", SearchOrder:=xlByRows, _
             SearchDirection:=xlPrevious, LookIn:=xlValues).Row

    Set rng = .Range("A2:A" & wsIRow)

    With rng
        Set aCell = .Find(What:="LOC", LookIn:=xlValues, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                    MatchCase:=True, SearchFormat:=False)

        If Not aCell Is Nothing Then

            wsO.Cells.Find(What:="LOC", SearchOrder:=xlByRows, _
         SearchDirection:=xlNext, LookIn:=xlValues).Offset(1, 1).Value = aCell.Offset(0, 1).Value
                         wsO.Cells.Find(What:="LOC", SearchOrder:=xlByRows, _
         SearchDirection:=xlNext, LookIn:=xlValues).Offset(1, 2).Value = aCell.Offset(0, 2).Value
                         wsO.Cells.Find(What:="LOC", SearchOrder:=xlByRows, _
         SearchDirection:=xlNext, LookIn:=xlValues).Offset(1, 3).Value = aCell.Offset(0, 3).Value

        End If
    End With
End With





Application.ScreenUpdating = True

End Sub

Спасибо очень очень очень заранее! С наилучшими пожеланиями, Маркус

редактировать: угадайте его работу сейчас: D: D

Answer 1

Вы не сказали, с какой частью у вас возникли проблемы, но я предполагаю, что сначала выполняется поиск раздела KW, а затем продолжается поиск, чтобы найти страну под ним. Если это так, возможно, это поможет.

Option Explicit
Private Sub Country_Click()

     ' country
    Dim wsIn As Worksheet, wsOut As Worksheet
    Dim rng As Range, rngOut As Range
    Dim KW As String, Country As String

    Set wsIn = ThisWorkbook.Sheets("Tabelle1")
    Set wsOut = Workbooks.Open("C:\...\Mappe2.xlsx").Worksheets("Tabelle1")

    KW = wsIn.Range("D24").Value
    Set rng = wsIn.Range("D25:I25")
    Country = rng.Cells(1, 1)

    Set rngOut = wsOut.UsedRange.Find(KW)
    If rngOut Is Nothing Then
        MsgBox KW & "Not FOund", vbExclamation
    Else
        MsgBox KW & " Found at " & rngOut.Address, vbInformation
        Set rngOut = wsOut.UsedRange.Find(Country, rngOut)
        If rngOut Is Nothing Then
            MsgBox Country & " Not Found", vbExclamation
        Else
            MsgBox Country & " Found at " & rngOut.Address, vbInformation
            rng.Copy rngOut
            MsgBox rng.Address & " copied to " & rngOut.Address, vbInformation
        End If
    End If

End Sub

Кнопка месяца более проста, и поскольку у вас есть проверка в ячейке A1 с раскрывающимся списком, вы можете удалить блок дела.

Private Sub Mth_Click()

    ' month
    Dim wsIn As Worksheet, wsOut As Worksheet
    Dim rng As Range, rngOut As Range, mthno As Integer

    Set wsIn = ThisWorkbook.Sheets("Tabelle1")
    Set wsOut = Workbooks.Open("C:\...\Mappe2.xlsx").Worksheets("Tabelle1")

    Set rng = wsIn.Range("A1:A7")

    Select Case LCase(Left(rng.Cells(1, 1), 3))
        Case "jan", "feb", "mar", "apr", "may", "jun", _
             "jul", "aug", "sep", "oct", "now", "dec"

            mthno = Month("1 " & rng.Cells(1, 1))
            rng.Copy wsOut.Range("A1").Offset(0, mthno - 1)
            MsgBox "Copied to month " & mthno, vbInformation

        Case Else
            MsgBox "Error with Month " & rng.Cells(1, 1), vbCritical
    End Select

End Sub