Board logo

標題: 請教查詢問題~~~求解惑!! [打印本頁]
作者: afu9240    時間: 2018-1-12 15:03     標題: 請教查詢問題~~~求解惑!!

各位高手及版主大大 好
  
                目前是vba小嫩嫩,但現行需求,想跟各位高手大大及版主 [attach]28235[/attach]請教~~求解惑~~謝謝[attach]28234[/attach][attach]28234[/attach]
作者: GBKEE    時間: 2018-1-15 08:49

本帖最後由 GBKEE 於 2018-1-15 08:51 編輯

回復 1# afu9240
有延伸的問題可在這主題繼續的發問(節省論壇資源)


[attach]28241[/attach]

UserForm1 請修改如上圖

UserForm1 電費查詢的程式碼
  1. Option Explicit
  2. Dim ComboBox元素(), Sh As Worksheet
  3. Private Sub UserForm_Initialize()
  4.     MultiPage1.Value = 0
  5. End Sub
  6. Private Sub ComboBox4_Change() '使用單位
  7.     電費查詢準則
  8. End Sub
  9. Private Sub ComboBox6_Change() '計費地址
  10.     電費查詢準則
  11. End Sub

  13. Private Sub ComboBox7_Change()  '計費週期
  14.     電費查詢準則
  15. End Sub
  16. Private Sub MultiPage1_Change()
  17.     If MultiPage1.Value = 2 Then 電費查詢ComboBox
  18. End Sub
  19. Private Sub 電費查詢ComboBox()
  20.     Dim i As Integer, xRng As Range
  21.     ComboBox元素 = Array(ComboBox4, ComboBox7, ComboBox6) '*** 控制項置於 陣列中**
  22.     Set Sh = Sheets("電費")
  23.     With Sh
  24.         Set xRng = .Cells(1, Columns.Count)  '工作表最右邊的儲存格
  25.         For i = 0 To UBound(ComboBox元素)
  26.             xRng.EntireColumn.Clear         '整欄清除
  27.             .Columns(i + 1).AdvancedFilter xlFilterCopy, , .Cells(1, Columns.Count), True
  28.             '**進階篩選 xlFilterCopy, **(空白為不指定參數值)** , .Cells(1, Columns.Count), True
  29.             xRng.Cells(Rows.Count).End(xlUp).Offset(1) = "查看全部"
  30.             With ComboBox元素(i)
  31.                 .List = Range(xRng.Cells(2), xRng.Cells(Rows.Count).End(xlUp)).Value
  32.                 '** List: ComboBox 或 ListBox 清單的來源,可指工作表儲存格範圍的值
  33.                 .Value = .List(.ListCount - 1)  '**List最後一個元素
  34.             End With
  35.         Next
  36.         xRng.EntireColumn.Clear
  37.     End With
  38. End Sub
  39. Private Sub 電費查詢準則()
  40.     Dim i  As Integer, Msg As Boolean, Rng As Range, Ar()
  41.     Sh.Cells(1, Columns.Count) = ""
  42.     Set Rng = Sh.Cells(1, Columns.Count)
  43.     Ar = Sh.Range("A1:C1").Value '**=Array("使用單位","計費週期","計費地址")
  44.     Sheets("工作表3").Range("a1").CurrentRegion.Clear
  45.     '**Range.CurrentRegion  傳回 Range 物件，該物件代表目前的區域。目前區域是指以任意空白列及空白欄的組合為邊界的範圍。
  46.     For i = 0 To UBound(ComboBox元素)
  47.         If ComboBox元素(i).ListIndex > -1 Then
  48.             If Rng.Text <> "" Then Set Rng = Rng.Cells(, 0)
  49.             Rng = Ar(1, i + 1)
  50.             Rng.Cells(2) = ComboBox元素(i)
  51.             If ComboBox元素(i).ListCount - 1 = ComboBox元素(i).ListIndex Then Rng.Cells(2) = "<>"
  52.             '查看全部 時 準則條件為 <>
  53.             'ListCount => 1 到 元素的總數 ,ListIndex =>0 元素的總數-1
  54.         End If
  55.     Next
  56.     If Rng <> "" Then
  57.         Set Rng = Range(Rng, Rng.End(xlToRight)).Resize(2)
  58.         Sh.Range("a1").CurrentRegion.AdvancedFilter xlFilterCopy, Rng, Sheets("工作表3").Range("a1")
  59.         
  60.     End If
  61.     Set Rng = Sheets("工作表3").Range("a1").CurrentRegion
  62.     'RowSource 屬性  指定 ComboBox 或 ListBox 清單的來源。
  63.      With ListBox1
  64.         .RowSource = ""
  65.         .Clear
  66.         .TextAlign = fmTextAlignCenter
  67.         .RowSource = Rng.Address(, , , 1, 1)
  68.         If Rng.Rows.Count > 1 Then
  69.             .ColumnCount = Sh.Range("a1").CurrentRegion.Columns.Count  '指定顯示的欄位數
  70.             .RowSource = Sheets("工作表3").Range("a1").CurrentRegion.Address(, , , 1, 1)
  71.             .Font.Size = 12
  72.         Else
  73.             .RowSource = ""
  74.             .Font.Size = 48
  75.             .ColumnCount = 1
  76.             .AddItem "查無資料"
  77.         End If
  78.         End With
  79. End Sub
複製代碼
作者: afu9240    時間: 2018-1-15 11:50

回復 2# GBKEE

感謝G神回復!!
   
  我需要時間消化一下,有問題再跟 G神大大請益!!!!太強了
論壇真的要持續贊助
作者: afu9240    時間: 2018-1-16 17:09

回復 3# afu9240


    G大您好

  請教一下,附件這個排序功能, 為何加上欄位名稱[attach]28242[/attach][attach]28242[/attach][attach]28242[/attach]

自動排序功能就無法執行 可以協助嗎???   [attach]28243[/attach][attach]28243[/attach]
作者: GBKEE    時間: 2018-1-17 12:03

回復 4# afu9240
試試看
  1. Sub tt()
  2.     Dim AR()
  3.     AR = Sheets("工作表1").Range("A1").CurrentRegion.Value
  4.     With Sheets("工作表2").Range("A1")
  5.         .CurrentRegion.Clear
  6.         .Resize(UBound(AR), UBound(AR, 2)) = AR
  7.          With .CurrentRegion
  8.             .Sort Key1:=.Range("A1"), Order1:=xlAscending, _
  9.             Key2:=.Range("B1"), Order2:=xlAscending, _
  10.             Key3:=Range("C1"), Order3:=xlAscending, Header:=xlNo
  11.            'Header:=xlNo  第一列不是標題
  12.            'Header:=xlYes 第一列包含標題
  13.          End With
  14.     End With
  15. End Sub
複製代碼
作者: afu9240    時間: 2018-1-17 16:41

回復 5# GBKEE


    感謝G大,感謝



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