不好意思新手又來請教資料比對問題麻煩各位了

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

21^# 跳轉到 »

發表於 2011-7-26 10:37 | 只看該作者

回復 20# ffntldj
1. If IsError(Application.Match(Rng, Ar, 0)) 這句是"在陣列比對不到同樣的字串傳回錯誤" 是說如果ar裡面不是Mod part和ACTION就會傳回值然後往下走嘛?
A:不是的, 是 Rng 比對  Ar 陣列中(TMD12,TDD13,MDT143,MDT14.....)  到沒有重複的, 然後下面的程式碼將Rng的值加入 Ar 陣列中

2.  If IsError(Application.Match(Rng(1) & Rng(2).Offset(, 1), Ar, 0)) Then
   這邊的ope_no 是用Offset的方式去寫,今天再想一各問題如果想用欄位名稱(ope_no)去認的話這邊該怎麼改寫?是不是用一個回圈去抓第一列的名字?
A:不了解你的意思
3.如果A sheet在比對 B sheet時候, 如果只要B sheet裡PART ID的第一碼到第N碼  (如TMD1213 ,TMD1214)當他等於 A Sheet裡面的值時 ,也要把它抓出來的話該怎麼做? 這我真的就不會了~~
修改一下,是這樣碼?

Sub 解答2Ex()
Dim Rng(1 To 2) As Range, Ar, Msg As Boolean, R As Range, N As String
Dim Word_In As String, Word_Out As String, Word_Look As String
Word_In = "Mod part" '進入字串
Word_Out = "ACTION" '離開字串
Word_Look = "MODIFY"
Set Rng(1) = Sheets("A").[A1] '尋找字串的起始點
ReDim Ar(0) '重新宣告陣列的維數
Do
If UCase(Rng(1)) = UCase(Word_In) Then Msg = True '是進入字串邏輯值=True
If UCase(Rng(1)) = UCase(Word_Out) Then Msg = False '是離開字串邏輯值=False
If Msg = True And UCase(Rng(1)) <> UCase(Word_In) Then '邏輯值=True 且字串不是"進入字串"
Set Rng(2) = Sheets("a").Columns(1).Find(Word_Look, After:=Rng(1), lookat:=xlWhole, MatchCase:=False) '尋找最接近的 "MODIFY"
If IsError(Application.Match(Rng(1) & Rng(2).Offset(, 1), Ar, 0)) Then '比對不到 "PARTID&OPE_NO"字串傳回錯誤值
If Ar(UBound(Ar)) <> "" Then ReDim Preserve Ar(UBound(Ar) + 1)
Ar(UBound(Ar)) = Rng(1) & Rng(2).Offset(, 1) 'UBound(Ar) 陣列的最大維數
End If
End If
Set Rng(1) = Rng(1).Offset(1) '設定 Rng(1)=Rng(1)的下一列
Loop Until Rng(1) = "" '離開 DO 迴圈的條件是 Until(直到) Rng(1) = ""
Set Rng(1) = Nothing '釋放變數
For Each R In Sheets("B").Range("a1").CurrentRegion.Rows 'R ->依序在Sheets("B")[A1延伸範圍的每一列
N = Mid(R.Cells(1), 1, 4) '篩選準則: PART ID的第一碼到第 4 碼
'Filter(Ar, N, True) ->傳回陣列包含基於指定篩選準則的一個字串陣列的子集
If UBound(Filter(Ar, N, True)) > -1 Then '-1 陣列中不是空的:有比對到) A欄的字串
If Rng(1) Is Nothing Then Set Rng(1) = R Else Set Rng(1) = Union(Rng(1), R) '設定變數
End If
Next
With Sheets("B1")
.UsedRange.Clear '清除 Sheets("B1")的內容
Rng(1).Copy .[A1]
End With
End Sub

複製代碼

TOP

ffntldj

小學生 Rank: 1

帖子: 26
主題: 6
精華: 0
積分: 33
點名: 0
作業系統: XP
軟體版本: OFFICE2003
閱讀權限: 10
性別: 男
註冊時間: 2011-7-19
最後登錄: 2013-5-13

論壇贊助勳章

22^#

發表於 2011-7-26 23:46 | 只看該作者

你好謝謝版主跟超級版主的大力幫忙有這個網站對我來說實在是獲益良多~ 謝謝你們

小弟初學vba 很多東西不會　都是在這努力爬文的　很感謝有這地方

以上的code沒錯錯的是我自己的觀念謝謝你們的糾正

14.If IsError(Application.Match(Rng(1) & Rng(2).Offset(, 1), Ar, 0)) Then
這邊抓到的rng(2)是MODIFY 然後用shift去抓ope_no的值,我的意思是如果不用offset 有什麼方式可以去認他的欄位名稱 ope_no ?

22.For Each R In Sheets("B").Range("a1").CurrentRegion.Rows 'R ->依序在Sheets("B")[A1延伸範圍的每一列

這應該是把b-sheet 一列一列的資料往下抓出來,如果我像上面一樣也是需要抓欄位名稱呢?

(就是當b-sheet part_id 跟 ope_no 都符合時,可以去抓到flow 跟flow1的名稱,然後把它copy到b1 sheet)

不知道這樣的描述看的懂嘛謝謝版主

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

23^#

發表於 2011-7-27 09:11 | 只看該作者

回復 22# ffntldj
Q1: 如果不用offset 有什麼方式可以去認他的欄位名稱 ope_no ?
A1:請往看13行: Set Rng(2) = Sheets("a").Columns(1).Find(Word_Look, After:=Rng(1), lookat:=xlWhole, MatchCase:=False) '尋找最接近的 "MODIFY"
ope_no 在 MODIFY的右邊一欄當然是用 Rng(2).Offset(, 1) 來表示最簡便, 或是 Sheets("a").Range( "B" & Rng(2).Row) 也可以

Q2:這應該是把b-sheet 一列一列的資料往下抓出來,如果我像上面一樣也是需要抓欄位名稱呢?
(就是當b-sheet part_id 跟 ope_no 都符合時,可以去抓到flow 跟flow1的名稱,然後把它copy到b1 sheet)
A2: VBA要抓資料的語法不止一個 ,如上 Sheets("a").Range( "B" & Rng(2).Row) 你可慢慢體會.

TOP

ffntldj

小學生 Rank: 1

帖子: 26
主題: 6
精華: 0
積分: 33
點名: 0
作業系統: XP
軟體版本: OFFICE2003
閱讀權限: 10
性別: 男
註冊時間: 2011-7-19
最後登錄: 2013-5-13

論壇贊助勳章

24^#

發表於 2011-8-1 22:42 | 只看該作者

回復 23# GBKEE

不好意思研究了一個禮拜還是很痛苦很多問題再來請教~ 謝謝

1 如附檔 A SHEET,之前都沒有空白格開(現在有空白所以不能用Do ,Loop Until Rng = "",我把它改寫成For each rng(1) in sheet("a").range(sheet(a).[A1],sheet(a)[A65536].End(xlup))
但現在遇到一個問題  之前ACTION 下方只會有一個MODIFY, 現在會有很多個,如果用 Set Rng(2) = Sheets("a").Columns(1).Find(Word_Look, After:=Rng(1), lookat:=xlWhole, MatchCase:=False)  '尋找最接近的 "MODIFY"
只會抓的到第一個. 如果ACTION下方只要是MODIFY SPEC的我都要抓到該怎麼做,如下範例

TMD101-E121--240.05
TMD102-E123--240.05
TMD103-E124--240.05
TMC102-E125--240.05

TMD101-E121--240.06
TMD102-E123--240.06
TMD103-E124--240.06
TMC102-E125--240.06

2  SHEET B 是資料庫裡的檔案,本來就有的 ,當a sheet抓出來之後(如上題),要去比對b sheet的資料(part_id 和ope_no欄位),如果確定資料符合就會寫入B1欄位(如B1),但是在B sheet裡面PARTID會有一些只有前六碼符合的資料(如綠色標記),也要將他視為資料符合這邊的話不知道怎麼改@@?

3 B1 Sheet的 item0~item3 是當check過a sheet 和b sheet之後如果資料符合,要將b sheet裡符合的資料 copy 到b1,  item4 則是從a的spec id 抓過來(如紫色標記),請問我該怎麼寫?

以上謝謝各位的教導~~

ScreenHunter_06 Aug. 01 22.37.gif (69.23 KB)

ScreenHunter_07 Aug. 01 22.40.gif (46.79 KB)

Book1.rar (4.76 KB)

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

25^#

發表於 2011-8-4 17:11 | 只看該作者

回復 24# ffntldj
試試看

Sub Ex()
Dim f As Range, f1 As Range, Rng As Range, Ar, E As Range, S1 As Integer, S2 As Integer
Dim d1 As Object, d2 As Object
Set d1 = CreateObject("scripting.dictionary") 'Ans:2 -的物件
Set d2 = CreateObject("scripting.dictionary") 'Ans:3 -的物件
With Sheets("A") 'Ans:1 -----
Set f = .Range("A1") '第一個"Mod part"
Do
Set f1 = .Columns(1).Find(What:="ACTION", MatchCase:=False, After:=f) '從 Mod part 往下找"ACTION"
S1 = Application.Match("OPE_NO", f1.EntireRow, 0) 'ACTION列找到"OPE_NO"欄位
S2 = Application.Match("SPEC ID", f1.EntireRow, 0) 'ACTION列找到"SPEC ID"欄位
Set Rng = .Range(f.Offset(1), f1.Offset(-1)) 'Mod part - ACTION"之間的儲存格
Do
If f1 Like "MODIFY*" Then
For Each E In Rng
d1(Split(E, "-")(0)) = d1(Split(E, "-")(0)) & "," & f1(1, S1).Value 'Split(E, "-")(0) 前六碼(KEY) 寫入"OPE_NO"(ITEM)
d2(E.Value) = f1(1, S2).Value 'MODIFY*(KEY) 寫入"SPEC ID"(ITEM)
Next
End If
Set f1 = f1.Offset(1)
Loop Until (f1 = "" And f1.End(xlDown).Row = Rows.Count) Or f1.Value = f.Value
Set f = .Columns(1).Find(What:=f, MatchCase:=False, After:=f) '往下尋找"Mod part"
Loop Until f.Address = "$A$1" '回到第一個"Mod part"時離開迴圈
End With 'Ans:1 -----End
S1 = 0
ReDim Ar(4, S1) '製定寫入B1陣列的欄位 5欄(0-4)
With Sheets("B")
S2 = 2
Do
If InStr(d1(Split(.Cells(S2, 1), "-")(0)), .Cells(S2, 2)) Then
'a sheet抓出來之後(如上題),要去比對b sheet的資料(part_id 和ope_no欄位),如果確定資料符合就會寫入B1欄位
Ar(0, UBound(Ar, 2)) = .Cells(S2, 1) 'Ans:2 -----
Ar(1, UBound(Ar, 2)) = .Cells(S2, 2) 'Ans:2 -----
Ar(2, UBound(Ar, 2)) = .Cells(S2, 3) 'Ans:2 -----
Ar(3, UBound(Ar, 2)) = .Cells(S2, 4) 'Ans:2 -----
Ar(4, UBound(Ar, 2)) = d2(.Cells(S2, 1).Value) 'Ans:3 -----
ReDim Preserve Ar(4, UBound(Ar, 2) + 1)
End If
S2 = S2 + 1
Loop Until .Cells(S2, 1) = "" '空白時離開迴圈
End With
With Sheets("B1")
.UsedRange.Offset(1).Clear
.[A2].Resize(UBound(Ar, 2), 5) = Application.Transpose(Ar)
End With
Set Rng = Nothing
Set E = Nothing
Set f = Nothing
Set f1 = Nothing
Set d1 = Nothing
Set d2 = Nothing
End Sub

複製代碼

TOP

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]