- 帖子
- 824
- 主題
- 6
- 精華
- 0
- 積分
- 904
- 點名
- 0
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2023-12-24
|
2#
發表於 2013-10-13 20:55
| 只看該作者
回復 1# queening
我找不到使用一般方式的解法,
不過若改使用 Excel VBA 倒是可以很容易的達到你的需求 :
 ChkData-a.zip (10.75 KB)
- Private Sub cbCheck_Click()
- Dim icol%, icols%
- Dim sStr$
- Dim lTemp&
- Dim rTar As Range
- Dim vTemp
-
- icol = 0
- Do
- sStr = InputBox("請輸入月份 :", "查詢行程", 10210)
- If sStr <> "" Then
- For lTemp = 1 To 12
- If sStr = CStr(Cells(1, lTemp)) Then
- icol = lTemp
- Exit For
- End If
- Next lTemp
- End If
- If icol = 0 Then
- vTemp = MsgBox("找不到輸入的月份資料 或 輸入的月份應為 10201 的形式, 是否重新輸入?", vbOKCancel + vbDefaultButton1)
- If vTemp = vbCancel Then Exit Sub
- End If
- Loop Until icol > 0
-
- sStr = ""
- lTemp = 2
- vTemp = 0
- Do
- If icol = 1 Or Cells(lTemp, icol).MergeArea.Count = 1 Then
- Set rTar = Cells(lTemp, icol)
- Else
- Set rTar = Cells(lTemp, Cells(lTemp, icol + 1).End(xlToLeft).Column)
- End If
- If rTar <> "" Then
- If sStr = "" Then
- sStr = sStr + rTar
- Else
- sStr = sStr & Chr(10) & Chr(10) & rTar
- End If
- End If
- lTemp = lTemp + 1
- icols = Cells(lTemp, Columns.Count).End(xlToLeft).Column
- If icols = 1 And Cells(lTemp, 1) = "" Then vTemp = vTemp + 1
- Loop Until vTemp > 10
- If sStr = "" Then
- MsgBox (Cells(1, icol) & "月 沒有查到任何行程.")
- Else
- MsgBox ("查尋到 " & Cells(1, icol) & " 月 的行程如下 :" & Chr(10) & Chr(10) & sStr)
- End If
- End Sub
|
|
