標題: [分享] 以欄號 計整欄多少數字 (14532) [打印本頁]

---

作者: hcm19522    時間: 2025-11-12 17:15     標題: 以欄號 計整欄多少數字 (14532)

[attach]38263[/attach][attach]38263[/attach]

---

作者: hcm19522    時間: 2025-11-12 17:18

(搜尋 輸入號碼 14532) google網址:https://hcm19522.blogspot.com/

---

作者: Andy2483    時間: 2025-11-20 16:26

回復 1# hcm19522


    謝謝前輩分享此主題,後學藉此帖練習陣列與字典,學習方案如下,請前輩們指教

執行前:
[attach]38293[/attach]

執行結果:
[attach]38294[/attach]

Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 1000, 1 To 2), K, Z, i&, j%, N&
Set Z = CreateObject("Scripting.Dictionary")
Brr = [A1:AB1].Resize(ActiveSheet.UsedRange.Rows.Count)
For j = 1 To UBound(Brr, 2)
   For i = 1 To UBound(Brr)
      If IsNumeric(Brr(i, j)) And Brr(i, j) <> "" Then Z(j) = Z(j) + 1
   Next
Next
For Each K In Z.Keys
   N = N + 1
   Crr(N, 1) = Split(Cells(1, K).Address, "$")(1)
   Crr(N, 2) = Z(K)
Next
If N > 0 Then [AD2].Resize(N, 2) = Crr
End Sub

---

作者: Quake    時間: 2025-11-23 11:24

底下是請我隔壁鄰居ChatGPT幫我寫的程式碼

Sub CountNumbersInColumns()

    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim r As Long, c As Long
    Dim countNum As Long
    Dim outCol As Long
    Dim outRow As Long
    Dim colLetter As String
   
    Set ws = ActiveSheet

    '自動偵測整張工作表真正的最後列
    lastRow = ws.Cells.Find(What:="*", _
                            LookIn:=xlFormulas, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious).Row

    '自動偵測整張工作表真正的最後欄
    lastCol = ws.Cells.Find(What:="*", _
                            LookIn:=xlFormulas, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious).Column

    '輸出從資料右側兩欄開始
    outCol = lastCol + 2
    outRow = 2 '從第 2 列開始輸出（第 1 列保留當表頭）

    '清除舊資料
    ws.Columns(outCol).Resize(, 2).ClearContents

    '表頭
    ws.Cells(1, outCol).Value = "欄號"
    ws.Cells(1, outCol + 1).Value = "結果"

    '逐欄統計
    For c = 1 To lastCol
        countNum = 0

        For r = 1 To lastRow
            If IsNumeric(ws.Cells(r, c).Value) And ws.Cells(r, c).Value <> "" Then
                countNum = countNum + 1
            End If
        Next r

        '若結果為 0，跳過不輸出
        If countNum > 0 Then

            '取得欄字母，例如 "C"
            colLetter = Replace(Split(ws.Cells(1, c).Address(False, False), "$")(0), "1", "")

            '輸出
            ws.Cells(outRow, outCol).Value = colLetter
            ws.Cells(outRow, outCol + 1).Value = countNum

            outRow = outRow + 1
        End If
    Next c

    MsgBox "統計完成！", vbInformation
End Sub

---

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