- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 3# ianlcc
二、工作表2
A1欄位：AAA（英文字）
B1欄位：BBB（英文字）
C1欄位：CCC（英文字） '附檔是數字
D1∼D20：數字(假設到第20列) '附檔是英文字
→匯出TXT檔變成：
①_AAA (BBB_D1 BBB_D2 BBB_D3 BBB_D4…) CCC
②如果D欄位只有D1有數字的話（D2∼D20空白的話），就變成_AAA BBB_D1 CCC '附檔是C1
③自動判斷如果D欄填入的數字只有第10列的話，只會加到BBB_ 後面就只會填到第10列的數字。 - Option Explicit
- Sub Ex_txt(Sh As String, A As String) '輸出文字檔
- Dim fs As Object
- Set fs = CreateObject("Scripting.FileSystemObject")
- Set fs = fs.CreateTextFile("d:\" & Sh & ".txt", True)
- fs.WriteLine (A)
- fs.Close
- End Sub
- Sub Ex_工作表1()
- Dim C As Range, A As String
- With Sheets("工作表1")
- A = "_" & .Range("a1")
- For Each C In .UsedRange.Columns("B:D").Rows
- A = A & " " & Join(Application.Transpose(Application.Transpose(C.Value)), " ")
- Next
- Ex_txt .Name, A
- End With
- End Sub
- Sub Ex_工作表2()
- Dim C As Range, A As String, Ar
- With Sheets("工作表3")
- For Each C In .UsedRange.Columns(3).Cells 'C1欄位：CCC（英文字）'附檔是數字
- A = A & .Range("B1") & "_" & C & " "
- Next
- If .UsedRange.Columns(3).Cells.Count > 1 Then
- A = "_" & .Range("a1") & " (" & Mid(A, 1, Len(A) - 1) & ") " & .Range("D1")
- Else 'D欄位只有D1有數字的話（D2∼D20空白的話），就變成_AAA BBB_D1 CCC '附檔是C1
- A = "_" & .Range("a1") & " " & A & .Range("D1")
- End If
- Ex_txt .Name, A
- End With
- End Sub
|
|
發表於 2014-2-18 16:48
| 