標題: [發問] 資料轉為指定欄數 超出指定數則寫入下一列 [打印本頁]

---

作者: starry1314    時間: 2018-11-22 17:04     標題: 資料轉為指定欄數 超出指定數則寫入下一列

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

想請問可否做到說
指定轉換到5欄之後 跳至下一列繼續寫入呢?
[attach]29713[/attach]
[attach]29711[/attach]
[attach]29712[/attach]

---

作者: 准提部林    時間: 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

---

作者: starry1314    時間: 2018-11-23 10:40

回復 2# 准提部林


    感謝 准大出手！！！

---

作者: starry1314    時間: 2018-11-23 14:59

本帖最後由 starry1314 於 2018-11-23 15:03 編輯

回復 2# 准提部林

[attach]29715[/attach]
    淮大 不好意思
這是否有限制呢?

Brr(N, 1) 陣列索引超出範圍

大約位於975就會停駐無法使用
[attach]29714[/attach]

---

作者: starry1314    時間: 2018-11-23 15:27

回復 4# starry1314


    調整了 好像是出在這
原始--> ReDim Brr(1 To UBound(Arr), 1 To 7)
列數小於轉換後會使用到的列數

更改後---> ReDim Brr(1 To 5000, 1 To 7)
可成功執行
但就沒有動態範圍了

---

作者: 准提部林    時間: 2018-11-23 16:41

回復 5# starry1314


忘了匯入列數會大于資料列數,
用 1 to 5000 或更大些都可以~~

---

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