返回列表 上一主題 發帖

請教查詢問題~~~求解惑!!

請教查詢問題~~~求解惑!!

各位高手及版主大大 好
  
                目前是vba小嫩嫩,但現行需求,想跟各位高手大大及版主 電費分攤系統.zip (51.61 KB) 請教~~求解惑~~謝謝
20180112.jpg
2018-1-12 15:00
yvonne

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

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


未命名.jpg
2018-1-15 08:13


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

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

TOP

回復 2# GBKEE

感謝G神回復!!
   
  我需要時間消化一下,有問題再跟 G神大大請益!!!!太強了
論壇真的要持續贊助
yvonne

TOP

回復 3# afu9240


    G大您好

  請教一下,附件這個排序功能, 為何加上欄位名稱
123.JPG
2018-1-16 17:06


自動排序功能就無法執行 可以協助嗎???    能.zip (16.59 KB)
yvonne

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 5# GBKEE


    感謝G大,感謝
yvonne

TOP

        靜思自在 : 脾氣嘴巴不好,心地再好也不能算是好人。
返回列表 上一主題