用VBA做查詢系統

aassddff736

請教各位前輩

我有一個儲位表單,六個鋼板工作表資料
想要在建立主頁做查詢系統:查鋼板資料,放置儲位,還有哪些空儲位 ,尚未建立儲位的鋼板
儲位查詢系統.rar (246.13 KB)

下載次數: 16

2024-3-3 15:55

鋼板資料常常會新增及刪除項目
儲位也常常會變換放置的鋼板

aassddff736

回復 1# aassddff736
更正有7個鋼板工作表

Andy2483

回復 2# aassddff736

謝謝前輩發表此主題與範例
建議刪除範例檔裡的多餘空欄空列,學習方案如下,請前輩參考

Option Explicit
Sub 刪除多餘空欄空列()
Dim s As Worksheet, i&, j%, R&, C%
'↑宣告變數:&是長整數,%是短整數
For Each s In Worksheets
'↑設逐項迴圈!令S變數是活頁簿裡的工作表
   Application.Goto s.[A1]: R = 0: C = 0
   '↑令游標跳到迴圈工作表的A1儲存格,令R變數歸零,令C變數歸零
   With Range(s.[A1], s.UsedRange)
   '↑以下是關於A1儲存格到有使用儲存格這範圍儲存格的程序
      For j = 1 To .Cells.Columns.Count
      '↑設順迴圈!令j從1 到該範圍的欄數
         If R < Cells(Rows.Count, j).End(xlUp).Row Then R = Cells(Rows.Count, j).End(xlUp).Row
         '↑如果R變數小於迴圈欄最後有內容儲存格的列號,就令R變數是該列號數
      Next
      If .Rows.Count > R + 1 Then Rows(R + 1 & ":" & .Rows.Count).Delete
      '↑如果範圍列數大於 R變數+1!就令多餘的列刪除
      For i = 1 To .Cells.Rows.Count
      '↑設順迴圈!令i從1 到該範圍的列數
         If C < Cells(i, Columns.Count).End(xlToLeft).Column Then C = Cells(i, Columns.Count).End(xlToLeft).Column
         '↑如果C變數小於迴圈列最後有內容儲存格的欄號,就令C變數是該欄號數
      Next
      If .Columns.Count > C + 1 Then Range(Cells(1, C + 1), Cells(1, .Columns.Count)).EntireColumn.Delete
      '↑如果範圍欄數大於 C變數+1!就令多餘的欄刪除
   End With
Next
End Sub

試執行後另存新檔

aassddff736

回復 3# Andy2483


謝謝您，非常感謝

aassddff736

回復 3# Andy2483

    我另存好了
儲位查詢系統2.rar (176.68 KB)

下載次數: 12

2024-3-6 22:18

Andy2483

回復 5# aassddff736

鋼板編號有重複,需手動排除重複後才顯示彙整資料:

下載 (119.22 KB)

2024-3-7 09:58

Option Explicit
Sub 資料彙整入主頁篩選區()
Dim Brr, Crr, Z, Q, i&, j%, R&, N&, S, T$, E&, TT$
Set Z = CreateObject("Scripting.Dictionary")
With Sheets("主頁")
   .Activate
   If .AutoFilter Is Nothing Then [B17:P17].AutoFilter Else If .FilterMode = True Then .ShowAllData
   With ActiveWindow
      .FreezePanes = False
      .ScrollRow = 13
      .SplitRow = 5
      .FreezePanes = True
   End With
   .UsedRange.Offset(17).EntireRow.Delete
   .[B:D].NumberFormat = "@"
   .[B:D].Font.Bold = True
End With
ReDim Crr(1 To 10000, 1 To 15)
Q = Array(Range([儲位!B3], [儲位!A65536].End(xlUp)), Range([儲位!E3], [儲位!D65536].End(xlUp)))
For Each Brr In Q
   Brr = Brr
   For i = 1 To UBound(Brr)
      N = N + 1: T = Brr(i, 2): Crr(N, 1) = Brr(i, 1): Crr(N, 2) = T: Z(T) = N
   Next
Next
E = N: Q = Array("1至588", "SUPER", "POWER", "POWER試產", "TEST", "待報廢", "報廢")
For Each S In Q
   Brr = Sheets(S).[A1].CurrentRegion
   For i = 3 To UBound(Brr)
      R = Z(Brr(i, 1))
      If Z.Exists(Brr(i, 2) & "|") Then TT = TT & " / " & S & "表_" & Brr(i, 2) Else Z(Brr(i, 2) & "|") = "A"
      If R = 0 Then N = N + 1: R = N
      For j = 1 To 14: Crr(R, j + 1) = Brr(i, j): Next
      If R > E Then Crr(R, 1) = S
   Next
Next
If N = 0 Then Exit Sub
If TT <> "" Then MsgBox "鋼板編號 " & Mid(TT, 4) & " 重複": Exit Sub
With [B18].Resize(N, 15): .Value = Crr: .Borders.LineStyle = 1: End With
End Sub

Sub 清除主頁篩選區資料()
With Sheets("主頁")
   .Activate
   If .AutoFilter Is Nothing Then [B17:P17].AutoFilter Else If .FilterMode = True Then .ShowAllData
   With ActiveWindow: .FreezePanes = False: .ScrollRow = 1: .SplitRow = 17: .FreezePanes = True: End With
   .UsedRange.Offset(17).EntireRow.Delete
End With
End Sub

aassddff736

回復 6# Andy2483


應為鋼板毀損所以開新的會有重複鋼板號情況,可以依前面活頁為優先嗎?基本報廢區不會編儲位號碼,但是會查資料

Andy2483

回復  Andy2483


應為鋼板毀損所以開新的會有重複鋼板號情況,可以依前面活頁為優先嗎?基本報廢區不會 ...
aassddff736 發表於 2024-3-7 13:23

照理說同鋼板編號 財產編號要相同,下圖所示產編號不同何因?

下載 (96.39 KB)

2024-3-7 13:53

If TT <> "" Then MsgBox "鋼板編號 " & Mid(TT, 4) & " 重複" : Exit Sub
改為
If TT <> "" Then MsgBox "鋼板編號 " & Mid(TT, 4) & " 重複" ': Exit Sub

aassddff736

回復 6# Andy2483

謝謝您的幫忙

下載 (85.62 KB)

2024-3-7 13:50

B欄"存放區域",如果鋼板沒有建立儲位編號 我想留白,但是報廢與帶報廢鋼板顯示
然後就是我要怎麼查空儲位

aassddff736

回復 8# Andy2483


新開一個一樣鋼板材編會不同報帳問題