返回列表 上一主題 發帖

用VBA做查詢系統

用VBA做查詢系統

請教各位前輩

我有一個儲位表單,六個鋼板工作表資料
想要在建立主頁做查詢系統:查鋼板資料,放置儲位,還有哪些空儲位 ,尚未建立儲位的鋼板
儲位查詢系統.rar (246.13 KB)
鋼板資料常常會新增及刪除項目
儲位也常常會變換放置的鋼板

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

TOP

本帖最後由 Andy2483 於 2024-3-4 10:18 編輯

回復 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

試執行後另存新檔
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 3# Andy2483


謝謝您,非常感謝

TOP

回復 3# Andy2483

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

TOP

回復 5# aassddff736

鋼板編號有重複,需手動排除重複後才顯示彙整資料:
20240307_1.jpg
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
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 6# Andy2483


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

TOP

回復  Andy2483


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

照理說同鋼板編號 財產編號要相同,下圖所示產編號不同何因?
20240307_2.jpg
2024-3-7 13:53


If TT <> "" Then MsgBox "鋼板編號 " & Mid(TT, 4) & " 重複" : Exit Sub
改為
If TT <> "" Then MsgBox "鋼板編號 " & Mid(TT, 4) & " 重複" ': Exit Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 6# Andy2483

謝謝您的幫忙
擷取.JPG
2024-3-7 13:50


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

TOP

回復 8# Andy2483


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

TOP

        靜思自在 : 信心、毅力、勇氣三者具備,則天下沒有做不成的事。
返回列表 上一主題