- 帖子
- 2834
- 主題
- 10
- 精華
- 0
- 積分
- 2890
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-11-27
|
2#
發表於 2018-11-23 10:19
| 只看該作者
Sub 匯入()
Dim Arr, Brr, i&, j%, N&, C%, xR As Range, xH As Range
Sheets("轉換後").UsedRange.Offset(1, 0).EntireRow.Delete
Arr = Sheets("原始資料").UsedRange
ReDim Brr(1 To UBound(Arr), 1 To 7)
For i = 2 To UBound(Arr)
If Arr(i, 1) = "" Then GoTo 101
N = N + 1: C = 2
Brr(N, 1) = Arr(i, 1): Brr(N, 2) = Arr(i, 2)
For j = 3 To UBound(Arr, 2)
If C = 7 Then N = N + 1: C = 2
If Arr(i, j) <> "" Then C = C + 1: Brr(N, C) = Arr(i, j)
Next j
101: Next i
If N = 0 Then Exit Sub
With [轉換後!A2].Resize(N, 7)
.Value = Brr
For Each xR In .Columns(1).Cells
If xR <> "" Then Set xH = xR
If xR(2) <> "" Or xR.Row = N + 1 Then
Range(xR, xH).Merge
Range(xR(1, 2), xH(1, 2)).Merge
End If
Next
.Borders.LineStyle = 1
End With
End Sub |
|
發表於 2018-11-22 17:04
| 
