Board logo

標題: [發問] txt 匯入excel ,並將資料分欄位,再將同一欄位的資料,作平均 [打印本頁]

作者: wj1228.518    時間: 2013-10-8 17:09     標題: txt 匯入excel ,並將資料分欄位,再將同一欄位的資料,作平均

本帖最後由 wj1228.518 於 2013-10-8 17:11 編輯

各位大大,請求協助,小弟先謝謝您

已爬過文--(網路上強人所寫的範例,拿來用)
--------------------------------------------------
Sub 匯入文字檔()
Dim MySht As Worksheet, uFile, ShtName, xSht As Worksheet, i&
Set MySht = Sheets("TEMP")
Application.ScreenUpdating = False
ShtName = Array("0", "430", "630", "1040", "1050", "2050", "3050")
'---------------------------------------
For i = 0 To UBound(ShtName)
    uFile = ThisWorkbook.Path & "\" & ShtName(i) & ".txt"
    If Dir(uFile) = "" Then GoTo NEXT_FILE
    '----------------------------------------
   
    For Each xSht In Sheets
        If xSht.Name = ShtName(i) Then
           Application.DisplayAlerts = False
           xSht.Delete
           Application.DisplayAlerts = True
        End If
    Next
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = ShtName(i)
    '-----------------------------------------
   
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & uFile, Destination:=Range("A1"))
         .AdjustColumnWidth = False
         .TextFileConsecutiveDelimiter = False
         .TextFileTabDelimiter = True
         .TextFileSemicolonDelimiter = False
         .TextFileCommaDelimiter = False
         .TextFileSpaceDelimiter = False
         .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
         .Refresh BackgroundQuery:=False
         .Delete
    End With
NEXT_FILE:
Next
'-------------------------------------------------------
MySht.Select
Application.ScreenUpdating = True
MsgBox "∼∼匯入完成∼∼ "
End Sub
--------------------------------------------------

問題:
需要分欄位(只需要區分 41366 這個欄位 ),
以便將資料41336 這個資料的欄位的抹些值,來作平均
(exp: =AVERAGE($E$161:$E$200))

資料內文如畫
(L)15862 (H)39905 (H-L)24043 |(Code)41366 (PPM)05555 |(TM)25025 (TA)023 (RH)000 (L1)01200 (L2)02000

請教各位大大幫忙,謝謝!
作者: wj1228.518    時間: 2013-10-9 11:12

回復 1# wj1228.518


    [attach]16276[/attach]

壓縮資料內有9個檔案
0.txt
430.txt
630.txt
1040.txt
1050.txt
2050.txt
3050.txt
是未經過整理的data
test.xls 是 程式
code.xls 是手動整理後的結果

跑test.xls 時,load 進來的資料,欄位未分割
所以想請教各位大大指點指點,
謝謝
作者: wj1228.518    時間: 2013-10-11 11:00

回復 2# wj1228.518


    [attach]16297[/attach]

謝謝各位前輩的指導,
第一個問題已經解決 (用錄製巨集的方式+先前的程式)
接下來第二個問題努力中...

附加檔案為第一個問題的程式

謝謝
作者: wj1228.518    時間: 2013-10-11 11:02

回復 3# wj1228.518


    Sub 匯入文字檔()
Dim MySht As Worksheet, uFile, ShtName, xSht As Worksheet, i&
Set MySht = Sheets("TEMP")
Application.ScreenUpdating = False
ShtName = Array("0", "430", "630", "1040", "1050", "2050", "3050")
'---------------------------------------
For i = 0 To UBound(ShtName)
    uFile = ThisWorkbook.Path & "\" & ShtName(i) & ".txt"
    If Dir(uFile) = "" Then GoTo NEXT_FILE
    '----------------------------------------
   
    For Each xSht In Sheets
        If xSht.Name = ShtName(i) Then
           Application.DisplayAlerts = False
           xSht.Delete
           Application.DisplayAlerts = True
        End If
    Next
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = ShtName(i)
    '-----------------------------------------
   
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & uFile, Destination:=Range("A1"))
         .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 950
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(8, 9, 11, 8, 5, 11, 11, 8, 8, 10)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
         .Delete
    End With
NEXT_FILE:
Next
'-------------------------------------------------------
MySht.Select
Application.ScreenUpdating = True
MsgBox "∼∼匯入完成∼∼ "
End Sub
作者: yuhuahsiao    時間: 2013-10-11 17:11

本帖最後由 yuhuahsiao 於 2013-10-11 17:12 編輯

回復 4# wj1228.518

我利用您上面的方式讀入檔案, 但我無權下載那些檔案
所以是利用最商方那一列資料試驗
可以輸入變動公式方式作業
約略如下



Sub avg()
For i = 1 To 10
Sheets("0").Cells(i + 2, 12).Formula = "=AVERAGE($E$" & i & ":$E$" & i + 2 & ")"
Next i
End Sub
作者: wj1228.518    時間: 2013-10-15 10:40

回復 5# yuhuahsiao


    yuhuahsiao 前輩
   抱歉,因為討論區(版規)有等級限制(小學生無法下載),
   若是您需要完整的檔案,請告知 email, 謝謝!
   也謝謝您的回覆,我也將您的程式加入, 試試看!
    謝謝!




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