返回列表下一主題上一主題發帖

[發問] 資料轉為指定欄數超出指定數則寫入下一列

starry1314

　暱稱: 豪

高中生 Rank: 3 Rank: 3

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2018-11-22 17:04 | 只看該作者

[發問] 資料轉為指定欄數超出指定數則寫入下一列

如下圖所示因要將資料輸出,已預先轉為此格式
但變成欄數太多無法輸出

想請問可否做到說
指定轉換到5欄之後跳至下一列繼續寫入呢?

多列轉指定欄數,超出下一列.rar (14.42 KB)

樓主熱帖

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2798
主題: 10
精華: 0
積分: 2854
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-4-20

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

TOP

starry1314