vba 依據textbox中所需入的值篩選出相對的筆數
- 帖子
- 51
- 主題
- 9
- 精華
- 0
- 積分
- 73
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- Office 2003
- 閱讀權限
- 20
- 註冊時間
- 2015-7-28
- 最後登錄
- 2015-12-17
|
回復 9# 准提部林
在匯入其他的excel檔執行後發現
.Select: .UsedRange.Clear: .[A1].Resize(Jm + 11, Km) = Arr
紅色字體部分出現錯誤
執行階段錯誤'1004'
請問是什麼問題呢
謝謝 |
|
|
|
|
|
|
|
- 帖子
- 2819
- 主題
- 10
- 精華
- 0
- 積分
- 2875
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-6-26
|
12#
發表於 2015-10-22 17:08
| 只看該作者
回復 11# t591nm
上傳範例檔如果可以正常執行, 其它檔就要去比對其差異, 才知道錯在哪?
資料必須是有固定規則的：
第１∼１１列，為〔表首〕
第１２列，為〔標題列〕
第１３∼１８列，為〔標註或備註〕吧（猜）
第１９列及以下，為〔資料明細區〕
因指定〔標題列〕符合文字才取出該欄，
所以取出資料由１９列改由１２列開始，
若要取５０筆〔明細〕，則包含〔標題〕之間的７列，Jm = TX + 7 才夠
TT = "_FL_C0_C0/C1_RLD2_RR_TS_C1_FDLD_DLD2_"
For j = 3 To UBound(Brr, 2)
If InStr(TT, "_" & Brr(1, j) & "_") = 0 Then Brr(1, j) = ""
Next
↑這段用來排除〔標題列〕不符合文字時，使其文字變為空字符""，以為下方取得符合〔欄〕資料的依據
請注意匯入文字檔及貼入資料的問題，
有沒考慮過為何資料會有６５５３６列，而其中有很多的〔#N/A〕錯誤值？
copy1 = Sheets(1).Range("A1:Q8000") 這才８０００列
Range("A1:Q65535") = copy1 卻貼成６５５３６列？？？？ |
|
|
|
|
|
|
|
- 帖子
- 51
- 主題
- 9
- 精華
- 0
- 積分
- 73
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- Office 2003
- 閱讀權限
- 20
- 註冊時間
- 2015-7-28
- 最後登錄
- 2015-12-17
|
13#
發表於 2015-10-22 17:18
| 只看該作者
回復 12# 准提部林
原來如此
感謝版大幫忙
目前測試後發現絕大多數都沒問題
我再試試
關於65535的部分
已經修改為一致的列數
至於為何設那麼多
是因為每次量測顆數不一定
故才設定多一點的列數
感謝大大 |
|
|
|
|
|
|
|
- 帖子
- 51
- 主題
- 9
- 精華
- 0
- 積分
- 73
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- Office 2003
- 閱讀權限
- 20
- 註冊時間
- 2015-7-28
- 最後登錄
- 2015-12-17
|
14#
發表於 2015-10-23 13:23
| 只看該作者
回復 12# 准提部林
已經知道為什麼有些檔案測試時 .[A1].Resize(Jm + 11, Km) = Arr 會出現錯誤
因為檔案中的格式不一致
如同版主所提到的：
第１∼１１列，為〔表首〕
第１２列，為〔標題列〕
第１３∼１８列，為〔標註或備註〕吧
第１９列及以下，為〔資料明細區〕
但我每個檔案的標題列不見得在第12列
因為第13~18列中有時後會為了備註其他資訊
所以第一筆測試數值不見得會在第19列
故我想判斷符合文字的部分要從第一列開始
依據目前工作表的作用範圍的欄來進行逐一的判斷
不知道我這樣的邏輯對不對 |
|
|
|
|
|
|
|
- 帖子
- 2819
- 主題
- 10
- 精華
- 0
- 積分
- 2875
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-6-26
|
15#
發表於 2015-10-23 15:09
| 只看該作者
本帖最後由 准提部林 於 2015-10-23 15:10 編輯
Sub vbaAFilter()
Dim j&, Jm&, k&, Km&, TX&, Arr, Brr, N&, uChk&, TT$, Sht As Worksheet
TX = TextBox1.Text: If TX = 0 Then Exit Sub
Arr = Sheets("工作表1").UsedRange.Value
ReDim Brr(1 To UBound(Arr, 2))
TT = "_FL_C0_C0/C1_RLD2_RR_TS_C1_FDLD_DLD2_"
For j = 1 To UBound(Arr)
If Arr(j, 1) = "Crystal" Then '以〔Crystal〕判斷是否為〔標題列〕
For k = 1 To UBound(Arr, 2)
Brr(k) = Arr(j, k) '標題文字納入陣列，不符合者填入空字符
If k > 2 And InStr(TT, "_" & Arr(j, k) & "_") = 0 Then Brr(k) = ""
Next k
uChk = 1: N = j - 1 '標題列上方的〔列數〕
End If
If Arr(j, 1) = 1 Then uChk = 2: N = j - 1: Jm = 0
'＿若Ａ欄為１，則判斷為〔明細〕的開始，Ｎ為上方列數，Jm歸零
If uChk = 0 Then GoTo 101
If uChk = 2 And Arr(j, 2) <> "PASS" Then GoTo 101
Jm = Jm + 1: Km = 0
For k = 1 To UBound(Arr, 2)
If Brr(k) <> "" Then Km = Km + 1: Arr(Jm + N, Km) = Arr(j, k)
Next
If uChk = 2 And Jm = TX Then Exit For
101: Next j
If Jm = 0 Then Exit Sub
On Error Resume Next: Set Sht = Sheets("PASS名單"): On Error GoTo 0
If Sht Is Nothing Then Set Sht = Sheets.Add: Sht.Name = "PASS名單"
With Sht
.Select: .UsedRange.Clear: .[A1].Resize(Jm + N, Km) = Arr
End With
End Sub
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
uChk =1 表示迴圈到〔標題列〕
uChk =2 表示迴圈到〔明細〕的開頭
資料底下的〔錯誤值〕務必先清除∼∼ |
|
|
|
|
|
|
|
- 帖子
- 2819
- 主題
- 10
- 精華
- 0
- 積分
- 2875
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-6-26
|
16#
發表於 2015-10-23 15:15
| 只看該作者
回復 14# t591nm
是可以將〔標題列〕及〔明細開頭〕強制固定列號，
若有不同，可手動調整，只要多保留幾個空白列當緩衝即可∼∼辦法是想出來的∼∼ |
|
|
|
|
|
|
|
- 帖子
- 51
- 主題
- 9
- 精華
- 0
- 積分
- 73
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- Office 2003
- 閱讀權限
- 20
- 註冊時間
- 2015-7-28
- 最後登錄
- 2015-12-17
|
17#
發表於 2015-10-23 15:23
| 只看該作者
回復 15# 准提部林
太感謝版主了
剛也想以Crystal做為標題列的判斷
只是還沒run出來
我是這樣寫
TT2 = "Crystal"
For j2 = 1 To UBound(Brr, 1)
If InStr(TT2, "_" & Brr(1, j) & "_") = 0 Then
只是錯在If InStr(TT2, "_" & Brr(1, j) & "_") = 0 Then 這一行
我先試試版大的辦法 |
|
|
|
|
|
|
|
- 帖子
- 51
- 主題
- 9
- 精華
- 0
- 積分
- 73
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- Office 2003
- 閱讀權限
- 20
- 註冊時間
- 2015-7-28
- 最後登錄
- 2015-12-17
|
18#
發表於 2015-10-26 09:17
| 只看該作者
回復 16# 准提部林
感謝版主
測試成功
讓我學習到很多細節
謝謝 |
|
|
|
|
|
|
|
- 帖子
- 51
- 主題
- 9
- 精華
- 0
- 積分
- 73
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- Office 2003
- 閱讀權限
- 20
- 註冊時間
- 2015-7-28
- 最後登錄
- 2015-12-17
|
19#
發表於 2015-10-26 17:25
| 只看該作者
回復 17# t591nm
版主不好意思
我又有個笨問題了
Private Sub CommandButton1_Click()
fileToOpen = Dir(Application.GetOpenFilename("Excel File(*.xls),*.xls"))
a = Split(fileToOpen, "/")
b = a(UBound(a))
MsgBox Left(b, InStr(b, ".") - 1)
End Sub
以上是我run過確定可以執行的程式碼
Private Sub CommandButton4_Click()
Dim Arr3 As Variant
Arr3 = Array("PASS名單", "DATA")
Sheets(Arr3).Copy
Arr3 = Application.GetSaveAsFilename(fileFilter:="*.xls, *.xls")
End Sub
以上程式碼中我就有問題了
我想讓CommandButton1_Click()中的b可以被CommandButton4_Click()來使用
由於觀念不清楚所以不知道怎麼引用
我所要的是另存新檔時檔名為該筆所匯入的檔名且不含副檔名
本來想說在CommandButton1_Click()中已經可以run出來要的檔名了
卻沒想到後期無法直接引用...
而且還有一個問題...可能是因為另存新檔中有兩個工作表...所以要按兩次存檔才可以
以上不知道如何排解
感謝大大 |
|
|
|
|
|
|
|
- 帖子
- 51
- 主題
- 9
- 精華
- 0
- 積分
- 73
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- Office 2003
- 閱讀權限
- 20
- 註冊時間
- 2015-7-28
- 最後登錄
- 2015-12-17
|
20#
發表於 2015-10-27 13:07
| 只看該作者
已解決
Private Sub CommandButton4_Click()
Dim nm As String, FileFolder As String
nm = Sheets("DATA").Range("G1").Value
Arr3 = Array("PASS名單", "DATA")
Sheets(Arr3).Copy
FileFolder = Application.GetSaveAsFilename(nm & "-", "(*.xls),*.xls")
Sheets("DATA").Range("G1").Clear
Sheets("PASS名單").Range("G1").Clear
ActiveWorkbook.SaveAs FileFolder
End Sub
這樣就可以達到我要的目的了 |
|
|
|
|
|
|
|
