返回列表 上一主題 發帖

[發問] 資料整理

本帖最後由 Andy2483 於 2022-10-27 14:44 編輯

回復 9# 准提部林
'謝謝前輩
'這帖習得多樣知識
'1.Range([資料!c1], [資料!a1].Cells(Rows.Count, 1).End(xlUp))
'  看似簡單的儲存格範圍!學到了 [資料!c1] 會讓Range()指向 資料表
'  以前誤以為 沒有工作表指向的Range() 一定是在ActiveSheet
'  否則一定要指向哪個表 Sheets("資料").Range()
'2.前輩很有心都會用不同的語法啟發後學們!不是機械式的回答!謝謝!
'3.Format(T(3), "0000") 學習到如何數字補足前方的0 成為想要的數字碼數
'4.用字典與陣列 鋪陳標題列與標題欄 好像已經看懂! 但又不會用!再勤練看看!
'5.學到 欄排序
'6.學到 去除 "|"符號(含)右邊的字元  Replace "|*", "", Lookat:=xlPart
'7.學到 留下[A1]儲存格!其餘儲存格刪除
'8.斜線隨儲存格縮放

一開始貼入:


欄排序:


列排序:


標題列留原料與顯示格線:


斜線隨儲存格縮放:


以下心得註解請前輩再指教!謝謝前輩
Sub TEST_A1()
Dim Arr, Brr, xD, T$(3), i&, j%, R&, C%, X&, Y%
'↑宣告變數,批次宣告T是字串變數 T(0)~T(3)
Call 清除
'↑執行副程式 清除()

Set xD = CreateObject("Scripting.Dictionary")
'↑令 xD是字典
Arr = Range([資料!c1], [資料!a1].Cells(Rows.Count, 1).End(xlUp))
'↑令 Arr是陣列,倒入 資料表裡C1到A欄最後一個有內容儲存格
'這兩個儲存格間擴展到最小方正區域儲存格的值
ReDim Brr(1 To UBound(Arr), 1 To 200)
'↑宣告 Brr陣列的範圍! 縱向是1 到 Arr陣列的列數
'橫向是1 到 200 欄數

For i = 2 To UBound(Arr)
'↑設外順迴圈 從2 到 Arr陣列最後列數
    For j = 1 To 3
    '↑設內順迴圈 從1 到3
        T(j) = Arr(i, j)
        '↑令迴圈中 T字串變數裝入Arr陣列對應值
        If T(j) = "" Then
        '↑如果 此內迴圈中 T字串變數 裝入了空格
           GoTo 101
           '↑條件成立!就跳到 101 繼續執行
        End If
    Next j
    T(0) = T(2) & "|" & Format(T(3), "0000")
    '↑令第1個T字串變數是 第3個T字串變數 & "|" & 第4個T字串(4碼數字)
    X = xD(T(1))
    '↑令X數字變數是 xD字典裡以 第2個T字串 值為key的item
    '一開始是查不到 item!但是字典裡已經收納了 第2個T字串 值為key
    '因為X數字變數!查不到就是初始值0

    Y = xD(T(0))
    '↑令Y數字變數是 xD字典裡以 第1個T字串 值為key的item
    '一開始也是查不到 item!但是字典裡已經收納了 第1個T字串 值為key
    '因為Y數字變數!查不到就是初始值0

    If X = 0 Then
    '↑如果X數字變數是初始值0
       R = R + 1
       '↑條件成立!R數字變數就累加 1
       X = R + 1
       '↑條件成立!X數字變數又以R數字變數再 +1
       '因為標題欄是從往下第2個開始
       xD(T(1)) = X
       '↑令 xD字典中 第2個T字串變數(編號) 為key的item = X數字變數
       '所以開始裝入的item是 數字2

       Brr(X, 1) = T(1)
       '↑一開始是令Brr陣列第2列第1欄是 第2個T字串變數(編號)
       '↑這是標題欄

    End If
    If Y = 0 Then
    '↑如果Y數字變數是初始值0
       C = C + 1
       '↑條件成立!C數字變數就累加 1
       Y = C + 1
       '↑條件成立!Y數字變數又以C數字變數再 +1
       '因為標題列是從往右第2個開始

       xD(T(0)) = Y
       '↑令 xD字典中 (原料)& "|" &(批號) 為key的item = Y數字變數
       Brr(1, Y) = T(0)
       '↑一開始是令Brr陣列第1列第2欄是 第1個T字串變數 (原料)& "|" &(批號)
       '↑這是標題列

    End If
    Brr(X, Y) = T(3)
    '↑標題列欄所對應的 批號放入 Brr陣列中
101: Next i
Brr(1, 1) = "   原料 編號"
'↑令Brr陣列第1列第1欄儲存格的字串
With [呈現表!A1].Resize(R + 1, C + 1)
'↑R是不包含標題列!所以要 +1 ,C是不包含標題欄!所以要 +1
    .Value = Brr
    '↑將Brr陣列從 呈現表[A1]貼入值
    .Columns(2).Resize(, C).Sort Key1:=.Cells(1, 2), Order1:=xlAscending, Header:=xlNo, Orientation:=xlLeftToRight
    '↑欄以標題列排序
    .Rows(2).Resize(R).Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlNo, Orientation:=xlTopToBottom
    '↑列以標題欄排序
    .Rows(1).Replace "|*", "", Lookat:=xlPart
    '↑把標題列去除 "|"符號(含)右邊的字元!標題列剩下 (原料)
    .Borders.LineStyle = 1
    '↑讓儲存格格線顯示 細實線
End With
End Sub

Sub 清除()
With Sheets("呈現表").UsedRange
    .Offset(1, 0).EntireRow.Delete
    .Offset(, 1).EntireColumn.Delete
    '留下[A1]儲存格!其餘儲存格刪除
End With
End Sub

TOP

回復 9# 准提部林
前輩午安
以下是用三個字典方式處裡,請前輩再指導!
謝謝前輩

Option Explicit
Sub TEST_20221028()
Dim Arr, i&, j&, T1, T2, T3, W, X, Y, Z, C, R
Arr = Range([資料!c1], [資料!a1].Cells(Rows.Count, 1).End(xlUp))
Set X = CreateObject("Scripting.Dictionary")
Set Y = CreateObject("Scripting.Dictionary")
Set W = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Arr)
   T1 = Arr(i, 1)
   T2 = Arr(i, 2)
   T3 = Format(Arr(i, 3), "0000")
   Y(T1) = ""
   X(T2 & "|" & T3) = ""
   W(T1 & "|" & T2 & "|" & T3) = T3
Next
ReDim Arr(1 To Y.Count + 1, 1 To X.Count + 1)
i = 1
For Each R In Y.KEYS
   i = i + 1
   Arr(i, 1) = R
   j = 1
   For Each C In X.KEYS
      j = j + 1
      Arr(i, j) = W(R & "|" & C)
      Arr(1, j) = IIf(i = 2, C, Arr(1, j))
   Next
Next
Arr(1, 1) = "   原料 編號"
With [呈現表!A1].Resize(UBound(Arr), UBound(Arr, 2))
    .Value = Arr
    .Columns(2).Resize(, UBound(Arr, 2)).Sort Key1:=.Cells(1, 2), Order1:=xlAscending, Header:=xlNo, Orientation:=xlLeftToRight
    .Rows(2).Resize(UBound(Arr)).Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlNo, Orientation:=xlTopToBottom
    .Rows(1).Replace "|*", "", Lookat:=xlPart
    .Borders.LineStyle = 1
End With
End Sub

TOP

        靜思自在 : 不要隨心所欲,要隨心教育自己。
返回列表 上一主題