- 帖子
- 406
- 主題
- 8
- 精華
- 0
- 積分
- 453
- 點名
- 0
- 作業系統
- WINDOWS 7
- 軟體版本
- 2007
- 閱讀權限
- 20
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2015-2-7
- 最後登錄
- 2021-7-31
|
本帖最後由 n7822123 於 2020-8-22 23:05 編輯
回復 8# b9208
但有一個問題,輸出中框線列數與資料列數相同,也就是輸出中沒有資料列數也劃框線。
因為有條件篩選後,資料列數與輸出列數會變成不一樣了,這剛剛改給你時沒考慮到
所以我新增 "Ro" 變數來紀錄篩選過後的列數
另、請教如於執行前,先清除輸出標題列以下儲存格之內容、框線及填滿顏色,不用.Delete方法,有其他方法可以達成?
用Clear 方法即可清除,我會把修改的地方用紅色表示
程式如下
Sub main()
Application.ScreenUpdating = False
Worksheets("輸出").Activate
Ci = Array(, 2, 3, 4, 5, 6, 7, 8, 18, 19, 20, 22, 22, 23, 23)
Set Rg = [資料!A1048576].End(xlUp)
If Rg.Row = 1 Then Exit Sub
[A4].CurrentRegion.Resize(, 15).Offset(1).Clear
Arr = Range([資料!W6], Rg)
Brr = [A5].Resize(UBound(Arr), 15)
[A2] = [資料!A2]
For R = 1 To UBound(Brr)
If Arr(R, 20) <> "" Then
Ro = Ro + 1
For C = 1 To 14
If C <= 10 Then Brr(Ro, C) = Arr(R, Ci(C))
If C = 11 Or C = 13 Then Brr(Ro, C) = Left(Arr(R, Ci(C)), 8)
If C = 12 Or C = 14 Then Brr(Ro, C) = Right(Arr(R, Ci(C)), 5)
Next C
End If
Next R
With [A5].Resize(Ro, 15) 'A~O欄填值+劃框線
.Value = Brr
.Borders.LineStyle = xlContinuous
End With
With [A5].Resize(Ro, 14) 'A~J欄做排序
.Sort key1:=.Item(2), key2:=.Item(10), Header:=xlNo
End With
With [H5].Resize(Ro, 2) 'H、I欄做取代
.Replace "*AA*", "AAA"
.Replace "*BBB*", "BBB"
.Replace "*CC*", "CCC"
.Replace "*DDD*", "DDD"
.Replace "*EEE*", "DDD"
.Replace "*FFF*", "FFF"
.Replace "*GGG*", "GGG"
.Replace "*HH*", "GGG"
.Replace "*MM*", "MMM"
.Replace "*LLL*", "LLL"
.Replace "*QQQ*", "LLL"
.Replace "*NNN*", "NNN"
.Replace "*TTT*", "NNN"
End With
End Sub
檔案如下
q2+2.rar (20.96 KB)
|
|