跨工作簿取数问题，跪求大神啊

相关人士 · 发表于 2016-10-18 12:34

蓝桥玄霜发表于 2016-10-18 12:12
请见附件。

谢谢蓝版，但是MAIL邮件行也不要啊，只要中间黄色区域数据
2.我想每次点击“导入到航班”按钮，不同表格数据在红色空单元格自动累加下去，而不是覆盖
整体意思是把CZ457，CZ447SGN等等数据，整合到航班明细一张表，
3.然后比如选CZ457，点了两次或多次"导入到航班"按钮，这时会弹出一个窗口“已导入，请勿重复导入”
这是为了避免F列出现重复的运单号

蓝桥玄霜 · 发表于 2016-10-19 10:21

Sub 按钮5_Click()
Dim myPath$, myName$, Arr1, i&, hb$, rq, Arr, n&, d
Dim rng As Range, Myr&
Set d = CreateObject("Scripting.Dictionary")
Set rng = Selection
If rng.Count > 1 Then Exit Sub
If rng = "" Then Exit Sub
If Intersect([b2:h32], rng) Is Nothing Then Exit Sub
Myr = Sheet3.Cells(Sheet3.Rows.Count, 2).End(xlUp).Row
Arr = Sheet3.Range("a5:c" & Myr)
For i = 1 To UBound(Arr)
x = Arr(i, 2) & "|" & Format(Arr(i, 3), "yyyy/m/d")
d(x) = ""
Next
myPath = ThisWorkbook.Path & "" & Cells(rng.Row, 1).Value & ""
myName = rng.Value & ".xls": n = Myr
With GetObject(myPath & myName)
Arr1 = .Sheets(1).UsedRange
Arr = .Sheets(1).[a1].Resize(UBound(Arr1), 7)
hb = Arr1(3, 2): rq = Arr1(3, 6)
If Not d.exists(hb & "|" & rq) Then
For i = 7 To UBound(Arr1)
If InStr(Arr1(i, 1), "TOTAL") = 0 And InStr(Arr1(i, 1), "Mail") = 0 Then
n = n + 1
Sheet3.Cells(n, 2) = hb: Sheet3.Cells(n, 3) = rq
Sheet3.Cells(n, 6).Resize(1, UBound(Arr, 2)) = Application.Index(Arr, i, 0)
End If
Next
Else
MsgBox "数据已经存在。"
End If
End With
End Sub

复制代码

相关人士 · 发表于 2016-10-19 15:56

蓝桥玄霜发表于 2016-10-19 10:21

谢谢蓝版抽空帮我这新人写代码，受宠若惊，小弟还有一个不情之请，能不能再帮忙改下
这个附件，跟上面那个大同小异，就是不会取区域，
工作簿不同，比如航班日期：2016-9-01，在同一个单元格，怎么只取右边日期部分
2.不要工作簿中红色行没有数据部分，也就是只取黄色区域的数（1和2文件夹里的工作簿排版有差异）
知道就是财富，小弟不会编程，又觉得免费索取有点尴尬，我凑够积分私信加您好友，发个红包请您吃顿饭或者买包烟抽吧

蓝桥玄霜 · 发表于 2016-10-20 09:52

Sub 按钮5_Click()
Dim myPath$, myName$, Arr1, i&, hb$, rq, Arr, n&, d
Dim rng As Range, Myr&
Set d = CreateObject("Scripting.Dictionary")
Set rng = Selection
If rng.Count > 1 Then Exit Sub
If rng = "" Then Exit Sub
If Intersect([b2:h32], rng) Is Nothing Then Exit Sub
Myr = Sheet3.Cells(Sheet3.Rows.Count, 2).End(xlUp).Row
Arr = Sheet3.Range("a5:c" & Myr)
For i = 1 To UBound(Arr)
x = Arr(i, 2) & "|" & Format(Arr(i, 3), "yyyy/m/d")
d(x) = ""
Next
myPath = ThisWorkbook.Path & "" & Cells(rng.Row, 1).Value & ""
myName = rng.Value & ".xls": n = Myr
With GetObject(myPath & myName)
Arr1 = .Sheets(1).UsedRange
Arr = .Sheets(1).[b2].Resize(UBound(Arr1), 5)
hb = Arr1(3, 3): rq = Arr1(3, 6)
If Not d.exists(hb & "|" & rq) Then
For i = 7 To UBound(Arr1)
If Left(Arr1(i, 2), 2) = "78" Then
n = n + 1
Sheet3.Cells(n, 2) = hb: Sheet3.Cells(n, 3) = Split(rq, "：")(1)
Sheet3.Cells(n, 5).Resize(1, UBound(Arr, 2)) = Application.Index(Arr, i, 0)
End If
Next
Else
MsgBox "数据已经存在。"
End If
End With
End Sub

复制代码

相关人士 · 发表于 2016-10-20 10:42

蓝桥玄霜发表于 2016-10-20 09:52

蓝版，工作簿里红色单元格里明明不是重复的数据，怎么也弹出“数据重复”呢？

蓝桥玄霜 · 发表于 2016-10-21 09:27

Sub 按钮5_Click()
Dim myPath$, myName$, Arr1, i&, hb$, rq, Arr, n&, d
Dim rng As Range, Myr&
Set d = CreateObject("Scripting.Dictionary")
Set rng = Selection
If rng.Count > 1 Then Exit Sub
If rng = "" Then Exit Sub
If Intersect([b2:h32], rng) Is Nothing Then Exit Sub
Myr = Sheet3.Cells(Sheet3.Rows.Count, 2).End(xlUp).Row
Arr = Sheet3.Range("a5:c" & Myr)
For i = 1 To UBound(Arr)
x = Arr(i, 2) & "|" & Format(Arr(i, 3), "yyyy/m/d")
d(x) = ""
Next
myPath = ThisWorkbook.Path & "" & Cells(rng.Row, 1).Value & ""
myName = rng.Value & ".xls": n = Myr
With GetObject(myPath & myName)
Arr1 = .Sheets(1).UsedRange
Arr = .Sheets(1).[a1].Resize(UBound(Arr1), 7)
hb = Arr1(3, 2): rq = Arr1(3, 6)
'If Not d.exists(hb & "|" & rq) Then
For i = 7 To UBound(Arr1)
If InStr(Arr1(i, 1), "TOTAL") = 0 And InStr(Arr1(i, 1), "Mail") = 0 Then
n = n + 1
Sheet3.Cells(n, 2) = hb: Sheet3.Cells(n, 3) = rq
Sheet3.Cells(n, 6).Resize(1, UBound(Arr, 2)) = Application.Index(Arr, i, 0)
End If
Next
'Else
'MsgBox "数据已经存在。"
'End If
End With
End Sub

复制代码

ranger丶亦 · 发表于 2018-8-26 21:26

最近找了好几天这样，终于找到了，学习一下

		自动登录	找回密码
密码			免费注册

[求助] 跨工作簿取数问题，跪求大神啊