返回列表 上一主題 發帖

[發問] 依指定區間日期、帳號 填入資料

回復 1# PJChen
有空幫我試試看是不是這樣比對 感謝 ^^"
  1. Public Sub 跨工作表比對練習()

  2.     Arr = [說明!I2].CurrentRegion
  3.     Brr = [預約!A1].CurrentRegion
  4.    
  5.     For X = 2 To UBound(Arr)
  6.         A = Arr(X, 1) & "-" & Arr(X, 4)
  7.         For Y = 2 To UBound(Brr)
  8.             B = Brr(Y, 2) & "-" & Brr(Y, 1)
  9.             If A = B And Arr(X, 4) <> "" Then
  10.                 Brr(Y, 3) = Arr(X, 7)
  11.                 Brr(Y, 7) = "#0000" & Arr(X, 5)
  12.             End If
  13.         Next Y
  14.     Next X
  15.    
  16.     [預約!A1].Resize(UBound(Brr, 1), UBound(Brr, 2)) = Brr

  17. End Sub
複製代碼

TOP

回復 7# PJChen

有空再試試看這樣行不行  感謝
  1. Public Sub 跨工作表比對練習()

  2.     Arr = [說明!I2].CurrentRegion
  3.     Brr = [預約!A1].CurrentRegion

  4.     For X = 2 To UBound(Arr)
  5.         A = Arr(X, 1) & "-" & Arr(X, 4)
  6.         For Y = X To UBound(Brr)
  7.             B = Brr(Y, 2) & "-" & Brr(Y, 1)
  8.             If A = B And Brr(Y, 3) = "" Then K = 0
  9.             If A = B And Arr(X, 4) <> "" And K <> 1 Then
  10.                 K = 1
  11.                 Brr(Y, 3) = Arr(X, 7)
  12.                 Brr(Y, 7) = "#0000" & Arr(X, 5)
  13.             Exit For
  14.             End If
  15.         Next Y
  16.     Next X

  17.     [預約!A1].Resize(UBound(Brr, 1), UBound(Brr, 2)) = Brr

  18. End Sub
複製代碼

TOP

回復 10# PJChen

把陣列改成 CELLS 應該可以 有空再試試看行不行 感謝
  1. Sub 預約更新_2()
  2. Application.ScreenUpdating = False
  3.     Arr = [說明!I2].CurrentRegion
  4.     Brr = [預約!A1].CurrentRegion

  5.     For X = 2 To UBound(Arr)
  6.         A = Arr(X, 1) & "-" & Arr(X, 4)
  7.         For Y = X To UBound(Brr)
  8.             B = Brr(Y, 2) & "-" & Brr(Y, 1)
  9.             If A = B And Brr(Y, 3) = "" Then K = 0
  10.             If A = B And Arr(X, 4) <> "" And K <> 1 Then
  11.                 K = 1
  12.                 Cells(Y, 3) = Arr(X, 7)
  13.                 Cells(Y, 7) = "#0000" & Arr(X, 5)
  14.             Exit For
  15.             End If
  16.         Next Y
  17.     Next X

  18. Application.ScreenUpdating = True
  19. End Sub
複製代碼

TOP

回復 12# PJChen

Sub 預約更新_2()
Application.ScreenUpdating = False '關閉更新畫面

    '把工作表的所有內容放到陣列
    Arr = [說明!I2].CurrentRegion
    Brr = [預約!A1].CurrentRegion

    For X = 2 To UBound(Arr) '在陣列裡的第2列開始到最後一列
        A = Arr(X, 1) & "-" & Arr(X, 4) '說明文字 帳號串聯日期
        For Y = X To UBound(Brr) '在陣列裡的第2列開始到最後一列
            B = Brr(Y, 2) & "-" & Brr(Y, 1) '預約文字 帳號串聯日期
            If A = B And Brr(Y, 3) = "" Then K = 0 '如果說明文字與預約文字相同 且預約X列位的第3欄位沒有內容 K就等於0 表示沒有被比對過
            If A = B And Arr(X, 4) <> "" And K <> 1 Then '如果說明文字的與預約文字相同 且說明X列位的第4欄位有內容 且K不等於1 表示沒有被比對過
                K = 1 '表示已經被比對過
                Cells(Y, 3) = Arr(X, 7) '把說明的預約板數放到預約工作表的單項取板欄位
                Cells(Y, 7) = "#0000" & Arr(X, 5) '把說明的 "#0000"串聯取板編號 放到預約工作表的取板編號欄位
            Exit For '跳到下一個迴圈
            End If
        Next Y
    Next X
    'D:F欄的公式值化 是因為  Brr = [預約!A1].CurrentRegion 的關係 所有內容放到陣列 或改成特定位置
'[預約!A1].Resize(UBound(Brr, 1), UBound(Brr, 2)) = Brr 因為沒有在陣列裡比對所以不需要
Brr指的是預約工作表比對後的內容
其實用字典方法會更好 但小弟還在學習中不太理解...有空還是會來看看大大們怎麼寫.順便學習^^"
Application.ScreenUpdating = True '開啟更新畫面
End Sub

TOP

回復 14# PJChen

那是一個動態範圍 會隨著儲存格內容變動 但前提是 只要有內容的儲存格 都是你要的 否則會選到一些不相關的內容
其實很多問題 都可以在這裡找到答案

達人總結的VBA精典的""八""類百條語句版

新手 VBA 入門常見問題

我都是在這裡學的 如果找不到答案 看看一些文章裡也許會有  再不行前輩們也會有答案 這裡真的可以學到很多
因為每個前輩的思考邏輯都有所不同 有時候看到前輩們寫 會發現 哇~原來還可以這樣......  呵呵..

TOP

回復 17# PJChen

我看不出來... >�苤捸@ 可不可以請 PJChen大大 做記號或著畫框框 說清楚一點 抱歉 我理解能力不太好 麻煩妳了 感謝

TOP

回復 17# PJChen

好像是 L欄格式 不是日期格式 有改了一下 有空妳再試試看是不是L欄的問題 感謝

預約取板0305.rar (37.36 KB)

TOP

本帖最後由 軒云熊 於 2021-3-5 04:53 編輯

回復 17# PJChen

抱歉 剛才發現 要點好幾次資料才會全部列出 判斷沒改好 再傳一次 >�苤捸@有空再幫我看看還有沒有其它問題 感謝

預約取板030501.rar (37.36 KB)

TOP

本帖最後由 軒云熊 於 2021-3-5 05:26 編輯

回復 17# PJChen

上面的檔案 沒改好會出錯 所以重新再上傳 想把上面的檔案刪除 可是不知道怎麼刪除 好像時間過了就無法刪除...抱歉了准大 往後我會注意確定了再上傳 


預約取板030502.rar (29.83 KB)

TOP

本帖最後由 軒云熊 於 2021-3-7 22:18 編輯

回復 22# PJChen

你是說這裡嗎?    妳指的是哪些部分可以框起來或著做記號嗎?   我看不出來 ...>"<

說明資料裡面沒有
03/02 週二        美
03/03 週三        佳
03/03 週三        美
03/04 週四        美


大        9                2021/2/18週四
大        10                2021/2/19週五
大        11                2021/2/19週五
大        12                2021/2/19週五
大        13                2021/3/2週二
大        14                2021/3/3週三
大        15                2021/3/4週四




預約取板0307.rar (37.93 KB)

TOP

        靜思自在 : 有心就有福,有願就有力,自造福田,自得福緣。
返回列表 上一主題