excel - Excel VBA:查找 - 比较两个文件 - 复制
问题描述
我是 VBA 的新手,从 12 小时开始尝试多个代码,但没有得到修复。我真的希望你能帮助我!
我有两个 Excel 文件,例如,它看起来像这样: 输入 File1
它应该通过下拉列表(一月、二月、....)找到月份,并将下面的特定单元格复制到 Excel-File 2 下的一月、二月、....
此外,它应该搜索由下拉列表(KW1、KW2、KW3、....)选择的单词,并复制 Excel 文件 2 中 ABCDE 下的单元格值。
喜欢: 主文件2
Excel-File 2 是“Master-Excel”,使用“werte_uebergeben”按钮,您可以将 File1 (A1:A11) 到 File2 的值发送到 (A1:A11) 或 (B1:B11)... 取决于标题
使用 File1 中的“Country”按钮,您可以将带有单元格 (E25:I25) 的 JP 行发送到 (G28:K28) 中的 File2 - 取决于单词 KW1、KW2 (G35:K35) 或 KW3 (G42:K42 )。
我真的希望通过图片可以更清楚地理解。
这是第二个作业的片段,但它应该自动将其粘贴到带有“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
结束子
非常非常非常非常感谢您!最好的问候马库斯
编辑:猜猜它现在工作:D:D
解决方案
您没有说您遇到问题的部分,但我想它是首先搜索 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
推荐阅读
- vue.js - VueJS:循环内的计算属性
- c++ - `std::move` objects into constructor when returning composite type?
- vba - 访问表单 VBA - 每个人都有相同的代码
- scala - 使用 circe-config 进行配置的通用解析器
- java - 字符串转换为 LocalDate
- python-3.x - 更改 APScheduler 默认作业存储位置
- javascript - 带有反应js的聊天地图,数组内的对象
- c++ - 如何根据窗口的客户区相对于屏幕的位置设置 Direct Draw 裁剪器
- javascript - resourceGroupField 多级
- python - 如何使用 Beautifulsoup 解析网页上 {} 之间的信息