麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 搜尋、比對，再複製過來的功能 [打印本頁]

作者: iceandy6150 時間: 2019-5-22 00:32 標題: 搜尋、比對，再複製過來的功能

大家好，我有一個功能想做，但是搜尋比對我不會寫

[attach]30644[/attach]
我會同時開三個檔案
一個是測試檔，裡面有按鈕，這邊也會列出所要的準則

第二個是資料檔
第三個是尺寸檔
共同點是學號
有點像ACCESS的主鍵

測試檔中會給所需要的學號跟這個學號所要查出來的資訊
然後按鈕按下後程式可以去搜尋比對把要的資料填進來測試檔中
[attach]30645[/attach]

因為同時開好三個檔
所以直接呼叫是可以取得資料的

但是搜尋比對，我就不會了
再請各位大大幫忙，謝謝

[attach]30646[/attach]

作者: jeffrey628litw 時間: 2019-5-22 13:13

回復 1# iceandy6150

放同一個檔案中可以嗎?

這2個檔案你參考一下，裡面設條件位置不同，你可以自己參考VBA研究如何修改放條件的位置。

[attach]30647[/attach]

作者: Kubi 時間: 2019-5-22 14:11

回復 1# iceandy6150
請參考

Private Sub CommandButton1_Click()
Dim arr
Dim brr()
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
ar = Array("資料.xlsx", "尺寸.xlsx")
For Each book In ar
Workbooks.Open ThisWorkbook.Path & "\" & book
arr = ActiveSheet.[A1].CurrentRegion
ActiveWorkbook.Close 0
For i = 2 To UBound(arr)
For j = 2 To UBound(arr, 2)
d(arr(i, 1) & arr(1, j)) = arr(i, j)
Next j
Next i
Next book
arr = ActiveSheet.[A1].CurrentRegion
ReDim brr(1 To UBound(arr) - 1, 1 To UBound(arr, 2) - 1)
For i = 2 To UBound(arr)
For j = 2 To UBound(arr, 2)
brr(i - 1, j - 1) = d(arr(i, 1) & arr(1, j))
Next j
Next i
[B2].Resize(UBound(brr), UBound(brr, 2)) = brr
Application.ScreenUpdating = True
Erase brr
Set d = Nothing
arr = ""
End Sub

複製代碼

注意：本程式會自動開啟兩個資料檔來比對，因此執行前不需先開啟資料檔案。

作者: iceandy6150 時間: 2019-5-22 22:53

回復 2# jeffrey628litw

感謝您的回覆，因為我的資料是在不同的檔案中，所以發問才會使用不同檔案
我會再自己試看看的，謝謝您

作者: iceandy6150 時間: 2019-5-22 22:55

回復 3# Kubi

哇~~ 你這個還可以自動開另外的檔案，然後還可以自動關檔
太棒了啦，這招我一定要學起來
感謝您的分享，功能完全符合我的需求
而且不需要寫很多行就搞定了
我光是陣列那邊就不行了....
再次感謝

作者: GBKEE 時間: 2019-5-23 06:10

回復 5# iceandy6150
VBA的可用不同的寫法,來達到同一效果

Option Explicit
Private Sub CommandButton1_Click()
Dim Rng() As Range, Ar(), xR As Variant, xC As Variant, i As Integer, ii As Integer
Dim xRng As Range
Application.ScreenUpdating = False
Ar = Array("測試.XLSM", "尺寸.XLSX", "資料.XLSX")
ReDim Rng(UBound(Ar)) '** Rng 重置元素與 Ar 一樣多
For i = 0 To UBound(Ar)
'**Workbooks(Ar(0)).Path ** 修改為尺寸 , 資料檔案的正確資料夾位置**
If i > 0 Then Workbooks.Open (Workbooks(Ar(0)).Path & "\" & Ar(i)) '**開啟檔案
With Workbooks(Ar(i))
Set Rng(i) = .Sheets(1).Range("A1").CurrentRegion '**設定個檔案的資料範圍
End With
Next
With Rng(0) '**測試.XLSM 清除要導入資料的範圍
.Range(.Cells(2, 2), .Cells(.Rows.Count, .Columns.Count)) = ""
End With
Set xRng = Rng(0).Cells(2, 1) '**測試.XLSM: 第一個學號
Ar = Rng(0) '**測試.XLSM: 範圍資料導入陣列
Do While xRng <> "" '迴圈: 學號的搜尋
For ii = 1 To UBound(Rng)
xR = Application.Match(xRng, Rng(ii).Columns(1), 0) '尺寸,資料中搜尋學號(的列號)
If Not IsError(xR) Then '**搜尋到學號(的列號)
For i = 2 To Rng(0).Rows(1).Cells.Count '**測試欄位名稱
'**xC 傳回是否搜尋到欄位名稱
xC = Application.Match(Rng(0).Cells(1, i), Rng(ii).Rows(1).Cells, 0)
If Not IsError(xC) Then Ar(xRng.Row, i) = Rng(ii).Cells(xR, xC) '**導入資料到陣列
Next
End If
Next
Set xRng = xRng.Offset(1) '**測試.XLSM: 下一個學號
Loop
For i = 1 To UBound(Rng)
Rng(i).Parent.Parent.Close '**關閉 "尺寸.XLSX", "資料.XLSX"
Next
Rng(0) = Ar '**陣列資料導入測試.XLSM的範圍
Application.ScreenUpdating = True
End Sub

複製代碼

作者: iceandy6150 時間: 2019-5-24 00:09

回復 6# GBKEE

感謝分享另一做法，今天把K大的程式碼印出來慢慢看
發現，真的很神奇，為什麼都沒有比對的東西在? 就可以做到效果?
我心裡面起初也是在想  應該要用個 IF 啦  FIND啦  之類的
不然怎麼知道  "測試"的學號  跟另外兩個檔案的學號  一不一樣
一樣才複製  不一樣就不複製

<一>K大居然用三個迴圈就搞定了，我無法理解啊......(太高深了)

然後我今天自己嘗試要寫一個小程式
從"測試"裡面設一按鈕  按下後  會開一個A檔案自動計算檔案中的B欄有幾列資料
然後我就設定一個陣列  要把B欄的資料每一列存起來

假設B欄判斷完有12筆資料  我的變數c就等於12
但是我Dim Arry(1,c)  我要一維12格的陣列
就是會出錯  跟我說一定要常數
那我先 Dim Arry() 然後  c=1 指定Arry(1,c) = 10 這樣也錯  (崩潰....)

<二>想順便請教  到底要怎麼設定動態的陣列呀?

<三>這是一個變形的比對需求
比對的順序在  "資料"檔案中
但是 "測試"檔案中，因為輸入需要比對的學號進來，不一定都是由小到大
可能0005  再來0001  再來0003
那我希望在按下按鈕後能自動排成0001  0003  0005的順序  把資料放進 "測試"檔案中

甚至  主索引鍵  若是改成以名字來當主要對照
就是在"測試"檔案中只有輸入  名字沒有學號
一樣能以 "資料"檔案中的順序來排
並複製過來 "測試"檔案裡

有辦法嗎?
[attach]30657[/attach]
以上，謝謝

作者: GBKEE 時間: 2019-5-24 08:17

回復 7# iceandy6150

排序的問題,你可用錄製巨集練習看看

Option Explicit
Sub Ex()
Dim ar(), c As Integer, i As Integer
'**ReDim 陳述式在程序層次中用來重新配置動態陣列變數的儲存空間。
ReDim ar(0 To 2)
For i = 0 To UBound(ar)
ar(i) = Chr(65) & i
Next
MsgBox UBound(ar) & vbLf & Join(ar, ",")
c = 8
ReDim ar(1 To c)
For i = 1 To UBound(ar) Step 2
ar(i) = Chr(66) & i
Next
MsgBox UBound(ar) & vbLf & Join(ar, " , ")
ReDim Preserve ar(1 To c + 10)
'** Preserve 選擇性引數。當改變原有陣列最後一維的大小時，仍然保有原來的資料的關鍵字
For i = c + 1 To UBound(ar) Step 3
ar(i) = i & Chr(67)
Next
MsgBox UBound(ar) & vbLf & Join(ar, ",,")
End Sub

複製代碼

作者: iceandy6150 時間: 2019-5-29 22:48

回復 8# GBKEE

謝謝~ 我再試試

初步使用變數視窗  是知道先把所有資料放進一個大陣列

  然後再去第二個檔案打開

  但是沒有 IF來做比較，怎麼知道第二個檔案要放什麼呢

使用錄製巨集要怎麼看?  把程式碼貼進去按鈕嘛? 怎麼看它自己一步一步跑?

作者: 准提部林 時間: 2019-5-30 10:31

如果只是簡單查詢, 資料也不多, 可用公式:
Sub 巨集1()
P$ = ThisWorkbook.Path & "\"
With Range("D2", Cells(Rows.Count, 1).End(xlUp)(2, 2))
   .Columns(1) = "=VLOOKUP(A2,'" & P & "[資料.xlsx]工作表1'!A:D,2,)"
   .Columns(3) = "=VLOOKUP(A2,'" & P & "[資料.xlsx]工作表1'!A:D,4,)"
   .Columns(2) = "=VLOOKUP(A2,'" & P & "[尺寸.xlsx]工作表1'!A:D,2,)"
   .Value = .Value
   .Replace "#N/A", ""
End With
End Sub

作者: iceandy6150 時間: 2019-6-4 00:34

回復 10# 准提部林

感謝大大提供另一作法
我會再試試看的

今天比較有空，我拿白紙慢慢畫，終於搞懂 KUBI大大為什麼能不用判斷式來做了
因為類似索引的方式，畫了快30分鐘~ 解開謎團了(開心~)

  原來就是先把所有的配對方法都記錄起來在 d 裡面
0001+姓名  就是  王小明
0001+班級  就是 XXX
以此類推

之後到結果那邊，如果我要的是0002、0003，然後標題我要的是姓名跟體重
那麼0002+姓名以及 0002+體重以及 0003+姓名  以及 0003+體重
都可以從 d裡面去找到上面四個相對應的值
然後正確顯示出來

  所以不管我結果那邊改成要四種標題  比如姓名、班級、喜好、體重
  或是只改成三種標題
  只要學號+標題
  都能正確地從 d 裡面去索引到相對應的值
  難怪可以不用判斷式
  厲害!!!

  只是說如果資料再更龐大一些，這種全紀錄的方式，會不會很耗記憶體
  (但目前以我使用的資料量，都還是足以正常使用)

作者: iceandy6150 時間: 2019-6-16 01:17

借這個主題再請問一下

比如 1年2月3日  經過程式轉化  可以變成 01年02月03日
但是如果來源只有剩下月  或日
該怎麼辦?  轉化後年月都錯了

第二個問題  現在是6月
我另存新檔想要用年+月+檔名
比如  "10806檔案"
108可能還好，就 Mid(year(Date),1,3) 就得到了
但是月就麻煩了
如果1~9月只有一個數字
10~12月是兩個數字
該怎麼讓檔名自動補0 呢?

第三個問題
然後其實我想要做到的是可以自動存成下個月的
比如現在是六月，但是存起來卻是 "10807檔案" 這樣

以上問題再發問，謝謝

[attach]30879[/attach]

[attach]30880[/attach]

作者: iceandy6150 時間: 2019-6-19 23:44

回復 12# iceandy6150

我自己找到解決方法了，真開心
如果給的資料，是有年有月，比如 1年5月這樣，就用一個做法
如果給的資料，只有月沒有年，比如9月、12月，就用另一辦法
這樣就能改成我自己要的 00年00月的格式了

c = .Range("D" & i).Value
If c Like "*年*" Then '有年有月就用這個方式改格式
c = Application.Text(Replace(Replace(c, "月", ":"), "年", ":"), "[hh]年mm月")
Else
f = Split(c, "月") '如果只有月判斷是一位數(1~9月)還是兩位數(10~12月)
If Len(f(0)) = 1 Then
c = "00年0" & f(0) & "月"
Else
c = "00年" & f(0) & "月"
End If
End If

複製代碼

為什麼要做這個功能呢
是因為來源資料很不一定
有時候是3月有時候11月有時候 1年5月、10年11月等等
位數變來變去
用MID很難抽取

然後又要套上規則
如果滿半年就怎樣怎樣---> 先算出年資換算成月是幾月滿半年就是年資>=6
如果滿一年 --> 年資>=12
用這些條件再來區分各級距的人該下什麼指令

以上小小發現，自問自答

作者: 准提部林 時間: 2019-6-20 10:09

回復 13# iceandy6150

年資??? 可能有如下情形???
1年3月5日
1年5月
1年12日
5月18日
3月
29日

作者: n7822123 時間: 2019-6-20 11:47

本帖最後由 n7822123 於 2019-6-20 11:53 編輯

回復 12# iceandy6150

第二個問題現在是6月
我另存新檔想要用年+月+檔名
比如 "10806檔案"
108可能還好，就 Mid(year(Date),1,3) 就得到了
但是月就麻煩了
如果1~9月只有一個數字
10~12月是兩個數字
該怎麼讓檔名自動補0 呢?

用格式mm即可.............自己試試看:
MsgBox Application.Text(Now, "m/d")
MsgBox Application.Text(Now, "mm/d"))

第三個問題
然後其實我想要做到的是可以自動存成下個月的
比如現在是六月，但是存起來卻是 "10807檔案" 這樣

不多說.....自己試看看:
MsgBox Application.Text(DateSerial(Year(Now), Month(Now) + 1, Day(Now)), "emm")

你應該要學的是，有關時間的函數與格式

作者: n7822123 時間: 2019-6-20 12:09

回復 13# iceandy6150

如果滿半年就怎樣怎樣---> 先算出年資換算成月是幾月滿半年就是年資>=6
如果滿一年 --> 年資>=12
用這些條件再來區分各級距的人該下什麼指令

參考看看

入職日期 = DateValue("6 / 4 / 2014") '自己設定入職日期
年資 = Application.Text(Now - 入職日期, "yy/mm")
MsgBox "張三年資共" & Split(年資, "/")(0) * 12 + Split(年資, "/")(1) & "個月"

作者: iceandy6150 時間: 2019-6-20 12:38

回復 14# 准提部林

年資的確有可能只有日或年+日或年+月或年月日都有
但是我處理的資料，是第二手
也就是只有計算到月而已

我拿到的資料要嘛就是 3月、6月、11月這樣
或是1年1月

所以只剩下兩種年+月、只有月
但是年，又有分為1位數的跟2位數的，比如3年跟 12年
月也是分為1位數的跟2位數的，比如4月跟 11月

所以我只好想辦法來處理
比如說1年以內的人，獎金發3000元
滿1年6月的發4500元

我就先把各種資料，轉成00年00月
再用MID去取，VAL()變成可計算的數字，然後就可以判斷
誰該發3000元，誰該發4500元....以此類推

感謝大大回復喔

作者: iceandy6150 時間: 2019-6-20 12:40

回復 16# n7822123

感謝大大的回覆
因為我手上拿到的資料並沒有到職日
不然照大大這樣寫，是很方便
這些寫法我都會存檔
以後若有用到，就可以派上用場
感謝感謝

作者: 准提部林 時間: 2019-6-20 17:13

回復 13# iceandy6150

Private Sub CommandButton1_Click()
c$ = Replace(Replace(Range("A1"), "年", ":"), "月", "")
If IsNumeric(c) Then c = "0:" & c
c = Application.Text(c, "[hh]年mm月")
Range("B1") = c
End Sub

======================

作者: 准提部林 時間: 2019-6-20 17:34

回復 15# n7822123

Private Sub CommandButton2_Click()
d& = Evaluate("edate(" & CLng(Date) & ", 1)")
ym$ = Format(d, "emm") & "檔案"
MsgBox ym
End Sub

作者: 准提部林 時間: 2019-6-20 17:38

回復 15# n7822123

Private Sub CommandButton2_Click()
d = CDate(Format(Now, "yyyy/m/1")) + 31
ym$ = Format(d, "emm") & "檔案"
MsgBox ym
End Sub

作者: 准提部林 時間: 2019-6-20 19:06

再來兩種方法:
Private Sub CommandButton2_Click()
ym$ = Format(Date - Day(Date) + 32, "EMM") & "檔案"
MsgBox ym
End Sub

Private Sub CommandButton2_Click()
ym$ = Format(DateAdd("m", 1, Date), "EMM") & "檔案"
MsgBox ym
End Sub

===========================

作者: n7822123 時間: 2019-6-21 01:06

本帖最後由 n7822123 於 2019-6-21 01:19 編輯

回復 20# 准提部林

感謝準大提供好多方法，受益匪淺 ^.^，算的我眼花撩亂了XD
Edate函數感覺可以完全被DateAdd所取代，只能用月當間隔，彈性有限

MsgBox Format(Application.EDate(Date, 1), "emm") & "檔案"
MsgBox Format(DateAdd("m", 1, Date), "emm") & "檔案"

收穫最多的是Evaluate函數，之前沒用過這個函數!
覺得非常好用，自己試玩了一下 ^.^
感覺上只要是工作表函數都可以計算
雖然我已經習慣用 Application.工作表函數或者 WorksheetFunction.工作表函數
但是這個函數的價值在於，可以直接把字串直接做運算，不需要額外解字串來處理，省下大量程式!

MsgBox Evaluate("3+2") '=5
MsgBox Evaluate("max(" & "20,30,40,99)")  '最大值99
MsgBox Evaluate("SIN(30*PI()/180)")  'Sin 30度=0.5
MsgBox Evaluate("DEC2HEX(253)")  '253的16進位表示=FD

但是VBA函數就不能了~~~~~可惜
MsgBox Evaluate("Hex(253)")  '錯誤

今天準大感覺心情很好，卯起來提供N種方法XD

作者: n7822123 時間: 2019-6-21 01:36

回復 23# n7822123

我也再提供方法~~這兩個其實是一樣的，用的函數不同

MsgBox Format(Year(Date) & "/" & Month(Date) + 1, "emm") & "檔案"
MsgBox Format(Year(Date) & "/" & DatePart("m", Date) + 1, "emm") & "檔案"

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)