12
返回列表 上一主題 發帖

關於vba指定 匯入文字檔

vavashop

帖子
78 
主題
30 
精華
0 
積分
109 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2014-5-15 
最後登錄
2018-9-16 

論壇贊助勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2015-4-24 00:05 | 只看該作者

關於vba指定 匯入文字檔

請問大大們
我有很多分頁
都錄製在同一巨集
但我執行時候要一個個按路徑
但我已經錄好了

請問該怎麼修改呢

Sub 巨集1()
'
' 巨集1 巨集
'

'
   
  
    Sheets("條件0-股號模組").Select
    Range("F6").Select
    With Selection.QueryTable
        .Connection = "TEXT;C:\Users\user\Google 雲端硬碟\L6模組\20140730模組\0股號模組.TXT"
        .TextFilePlatform = 950
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(6, 8, 10, 10, 10, 10, 11)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Sheets("條件1-周模組").Select
    Range("F7").Select
    With Selection.QueryTable
        .Connection = "TEXT;C:\Users\user\Google 雲端硬碟\L6模組\20140730模組\1周模組.TXT"
        .TextFilePlatform = 950
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(6, 8, 10, 10, 10, 10, 10, 10, 10)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Sheets("條件2-日模組").Select
    Range("E11").Select
    With Selection.QueryTable
        .Connection = "TEXT;C:\Users\user\Google 雲端硬碟\L6模組\20140730模組\2日模組.TXT"
        .TextFilePlatform = 950
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(6, 8, 10, 10, 10, 10)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Sheets("條件3-月模組").Select
    Range("E8").Select
    With Selection.QueryTable
        .Connection = "TEXT;C:\Users\user\Google 雲端硬碟\L6模組\20140730模組\3月線模組.TXT"
        .TextFilePlatform = 950
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(6, 8, 10, 10, 10, 10, 10, 10, 10)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
  
    Sheets("條件4-量架構").Select
    Range("D5").Select
    With Selection.QueryTable
        .Connection = "TEXT;C:\Users\user\Google 雲端硬碟\L6模組\20140730模組\4量模組.txt"
        .TextFilePlatform = 950
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1)
        .TextFileFixedColumnWidths = Array(6, 8, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, _
        10, 12, 10, 10, 10, 9, 10)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
   
    Sheets("條件5-其他").Select
    Range("E11").Select
    With Selection.QueryTable
        .Connection = "TEXT;C:\Users\user\Google 雲端硬碟\L6模組\20140730模組\5其他.txt"
        .TextFilePlatform = 950
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(6, 8, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
   
    Sheets("條件6-均線模組").Select
    Range("E6").Select
    With Selection.QueryTable
        .Connection = "TEXT;C:\Users\user\Google 雲端硬碟\L6模組\20140730模組\6均線模組.txt"
        .TextFilePlatform = 950
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(6, 8, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Sheets("條件7-資0.3模組").Select
    Range("H7").Select
    With Selection.QueryTable
        .Connection = "TEXT;C:\Users\user\Google 雲端硬碟\L6模組\20140730模組\7資03模組.txt"
        .TextFilePlatform = 950
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(6, 8, 10, 10, 10, 10, 10, 10, 10)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Sheets("條件8-跳空模組").Select
    Range("D9").Select
    With Selection.QueryTable
        .Connection = "TEXT;C:\Users\user\Google 雲端硬碟\L6模組\20140730模組\8跳空模組.txt"
        .TextFilePlatform = 950
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(6, 8, 10, 13)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
   
    End With
   
   
End Sub
收藏 分享

vavashop

帖子
78 
主題
30 
精華
0 
積分
109 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2014-5-15 
最後登錄
2018-9-16 

論壇贊助勳章
12#
發表於 2015-4-30 16:43 | 只看該作者
謝謝大大 我試看看

TOP

gn001038600

帖子
21 
主題
1 
精華
0 
積分
52 
點名
0  
作業系統
WIN7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2015-3-13 
最後登錄
2024-5-2 
11#
發表於 2015-4-29 16:04 | 只看該作者
回復 10# vavashop


這類型之條件,我記得錄製的無法達成(小的才疏學淺@@,可能有其他方法小ㄉ不知道),但建議自行撰寫   
如您所提出之條件 "A欄位要成立  與  B欄位要成立   兩者成立後 的 C D E三個欄位 只要有是大於0就出現嗎
dim data(100,5) , amount

amount=0
for i = 1 to sheets(2).range("A65536").end(xlup).row
                 if sheets(2).cells(i,1)="A條件" and sheets(2).cells(i,2) ="B條件" then
                          if  'CDE欄位條件成立 then
                                 amount =amount+1
                                         for  j = 1 to 5
                                                    data(amount,j)=sheets(2).cells(i,j)
                                         next
                         end if                          
                 end if           
next

for i = 1 to amount
       for j = 1 to 5
            sheets(1).cells(i,j)=data(i,j)
       next
next

您可以試試看條件填入 再跑跑看 可否!

TOP

vavashop

帖子
78 
主題
30 
精華
0 
積分
109 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2014-5-15 
最後登錄
2018-9-16 

論壇贊助勳章
10#
發表於 2015-4-29 15:23 | 只看該作者
回復 9# gn001038600


    大大我發現 都是一樣的
無論幾個篩選
都一定要全部符合才能被篩選出來

篩選 的 條件有所謂的

A欄位要成立  與  B欄位要成立   兩者成立後 的 C D E三個欄位 只要有是大於0就出現嗎？
A        B        C        D        E
1        2        4        1        2
2        3        5        4        3
3        7        6        7        4
4        1        7        4        5
5        4        3        6        2
6        7        4        7        3
7        4        5        3        4
8        5        7        6        5
7        1        6        7        4
2        1        6        7        4
2        8        8        5        7
2        5        7        1        6

TOP

gn001038600

帖子
21 
主題
1 
精華
0 
積分
52 
點名
0  
作業系統
WIN7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2015-3-13 
最後登錄
2024-5-2 
9#
發表於 2015-4-29 13:55 | 只看該作者
回復 8# vavashop


    您可以把原始檔案跟訴求貼上來嗎   我幫您修改

TOP

vavashop

帖子
78 
主題
30 
精華
0 
積分
109 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2014-5-15 
最後登錄
2018-9-16 

論壇贊助勳章
8#
發表於 2015-4-29 13:42 | 只看該作者
Sub test()
Dim row_s1 As Integer

'檢查工作表1的B欄已有資料行數
    row_s1 = Worksheets(1).Range("B65535").End(xlUp).Row

'B1無資料時，row_s1 =0
    If row_s1 = 1 Then
        If Cells(row_s1, 2) = "" Then
            row_s1 = 0
        End If
    End If


'第一次選資料0，並貼到工作表1
    Worksheets(2).Select
    ActiveSheet.Range("$A$1D$10").AutoFilter Field:=2, Criteria1:="0"
    ActiveSheet.Range("$A$1D$10").AutoFilter Field:=3, Criteria1:="1"
    Range("B2:l9").Select
    Selection.Copy
    Worksheets(1).Select
    Cells(row_s1 + 1, 2).Select
    ActiveSheet.Paste
   
'第二次選資料1，並貼到工作表1
    row_s1 = Worksheets(1).Range("B65535").End(xlUp).Row

    Worksheets(2).Select
    ActiveSheet.Range("$A$1D$10").AutoFilter Field:=3, Criteria1:="1"
     ActiveSheet.Range("$A$1D$10").AutoFilter Field:=2, Criteria1:="0"
    Range("B2:l9").Select
    Selection.Copy
    Worksheets(1).Select
    Cells(row_s1 + 1, 2).Select
    ActiveSheet.Paste
End Sub


Sub a1()



Worksheets(2).Select
    ActiveSheet.Range("$A$1D$10").AutoFilter Field:=2, Criteria1:="0"


End Sub


Sub a2()


    Worksheets(2).Select
    ActiveSheet.Range("$A$1D$10").AutoFilter Field:=3, Criteria1:="1"


End Sub
---------------------------

我用了下面這樣 一樣不行
Sub 巨集2()
'
' 巨集2 巨集
'

'
  Dim row_s1 As Integer

'檢查工作表1的B欄已有資料行數
    row_s1 = Worksheets(1).Range("B65535").End(xlUp).Row

'B1無資料時，row_s1 =0
    If row_s1 = 1 Then
        If Cells(row_s1, 2) = "" Then
            row_s1 = 0
        End If
    End If
   
   
  
  
  Call a2
Call a1
  

        
    Range("B2:l9").Select
    Selection.Copy
    Worksheets(1).Select
    Cells(row_s1 + 1, 2).Select
    ActiveSheet.Paste


End Sub

TOP

vavashop

帖子
78 
主題
30 
精華
0 
積分
109 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2014-5-15 
最後登錄
2018-9-16 

論壇贊助勳章
7#
發表於 2015-4-29 13:41 | 只看該作者
我遇到的問題是
我有兩個
AutoFilter Field:=5  Criteria1:="3"
AutoFilter Field:=6  Criteria1:="3"

我需要的是 如果欄位五有3的選出來後 在選第二輪的篩選欄位六有3的

因為這樣有先後順序的問題
所以不知道該怎麼改

因為我會把這兩個條件對調,因為結果會不同

TOP

gn001038600

帖子
21 
主題
1 
精華
0 
積分
52 
點名
0  
作業系統
WIN7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2015-3-13 
最後登錄
2024-5-2 
6#
發表於 2015-4-29 13:25 | 只看該作者
vavashop 大大 由於我加入不久還無法發送短訊息,關於您的問題

1.您是要擷取您於C:\Users\user\Google 雲端硬碟\L6模組\20140730模組\0股號模組.TXT"內的資料至您要的工作表內對吧

2.因加入時間短,還無法發出短訊息
    AutoFilter Field:=6  Criteria1:="3"
    <是指您要選擇最左數起第6行欄位內,取出含有3字樣的資料出來> 若要改變條件 , 把""內的3改成您要篩選的資料就可以嚕,您可以試試看!

TOP

vavashop

帖子
78 
主題
30 
精華
0 
積分
109 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2014-5-15 
最後登錄
2018-9-16 

論壇贊助勳章
5#
發表於 2015-4-29 12:41 | 只看該作者
悶了∼∼
看不懂∼∼
我的是抓取我存在我的資料夾中的文字檔

TOP

gn001038600

帖子
21 
主題
1 
精華
0 
積分
52 
點名
0  
作業系統
WIN7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2015-3-13 
最後登錄
2024-5-2 
4#
發表於 2015-4-29 10:47 | 只看該作者
您好!
提供之前我有寫過類似txt檔的擷取方式重點(我之前是擷取CSV. ,但是方法是一樣的)

Step1. 確認路徑(類似寫法如下)

ppath = "M:\QC\檢驗資料\Wafer\OQC特性\" + doc + "\"
myfile = Dir(ppath + "*.CSV")
<確認路徑並搜尋所有該資料夾內之csv檔>

Step2. 打開檔案並將之寫入#1暫存
            If myfile = "" Then GoTo labexit  '搜尋不到跳出重搜
            gfilename = ppath + myfile
            Open gfilename For Input As #1

Step3. 確認搜尋條件
                    If Mid(textline, 1, 3) = "TTV" Then 'TTV data
                       search = ","
                       search1 = InStr(7, textline, search, vbTextCompare)
                       search2 = InStr(search1 + 1, textline, search, vbTextCompare)
                       search3 = InStr(search2 + 1, textline, search, vbTextCompare)
<我是使用字串搜尋到我要資料的位置>

Step4. 最後當然是設立個迴圈把自己想要的資料都抓近來嚕
                   Do While Not EOF(1)
                         Line Input #1, textline
                   loop

以上是我的擷取方式,不知道有沒有回答到重點@@若有問題可以一起討論唷

TOP

        靜思自在 : 犯錯出懺悔心，才能清淨無煩惱。
12
返回列表 上一主題