Board logo

標題: excel折行分裂問題 [打印本頁]
作者: lionliu    時間: 2015-4-10 10:21     標題: excel折行分裂問題

各位大個好我有一個excel問題如範例
我想要讓工作表1內容轉換成工作表2，行數不等不知vba要如何撰寫。
[attach]20621[/attach]
請各位大哥幫我解惑一下。
作者: lionliu    時間: 2015-4-13 11:17

不好意思沒表示清楚，
工作表1 A2 要轉成工作表的A2、A3、A4三列
       "      A4    ""                      ""  A6、A7兩列
作者: GBKEE    時間: 2015-4-13 16:07

回復 2# lionliu
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim E As Range, S As String
  4.     For Each E In Sheets("工作表1").UsedRange.Columns(1).Cells '你的資料在A欄
  5.         S = S & IIf(S <> "", ",", "") & Join(Split(E.Value, vbLf), ",")
  6.     Next
  7.     Sheets("工作表2").[A1].Resize(UBound(Split(S, ",")) + 1) = Application.Transpose(Split(S, ","))
  8. End Sub
複製代碼
作者: lionliu    時間: 2015-4-13 16:26

回復 3# GBKEE
測試可以跑了謝謝大哥
作者: lionliu    時間: 2015-4-16 15:54

回復 3# GBKEE
GB大哥：
若我前面有欄位編號：是否可以加進去如附件
[attach]20670[/attach]
有事著自行以範例修改，但是做到後來還是無解
作者: GBKEE    時間: 2015-4-17 14:39

回復 6# lionliu
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim E As Range, D  As Object, Sp As Variant
  4.     Set D = CreateObject("SCRIPTING.DICTIONARY") '字典物件
  5.     For Each E In Sheets("工作表1").UsedRange.Columns(2).Cells '你的資料在B欄
  6.         For Each Sp In Split(E.Value, vbLf)
  7.             D(E.Offset(, -1) & ":" & Sp) = ""    '字典物件的Key值=>  E.Offset(, -1) & ":" & Sp
  8.         Next
  9.     Next
  10.     Sheets("工作表2").[A1].Resize(D.Count) = Application.Transpose(D.KEYS)
  11. End Sub
複製代碼
作者: lionliu    時間: 2015-4-20 14:37

回復 7# GBKEE


  謝謝gb大大
看了你的2個vba讓我有更進一步的感覺，真是太強大了。
作者: lionliu    時間: 2015-6-6 09:07

回復 6# GBKEE
GBKEE大大好

我用系統轉出的資料若用上述方法，當COPY到記事本或淳晟記事本後。
會在折行的文字前面會加上" 如附件不知有方法可以克服。
[attach]21112[/attach]
作者: lionliu    時間: 2015-6-6 10:29

回復 6# GBKEE
GB老大不用了，我自己測試出來了，謝謝您。
作者: lionliu    時間: 2015-8-13 13:24

回復 9# lionliu
GB大哥：
不好意思又碰到問題想不出解決方法，所以有上來請教你。
與上面問題雷同，我想讓工作表1 轉成工作表2。[attach]21707[/attach]
作者: lionliu    時間: 2015-8-13 15:11

回復 10# lionliu
這是我是做的程式碼，不知是否有哪位大個可以告訴我要如何修改
  1. Sub inv()
  2. '
  3. Dim i, j, k, rcnt As Integer
  4. Dim myArray() As String

  6. rcnt = Sheets(1).Cells(Rows.Count, 3).End(xlUp).Row
  7. For i = 5 To rcnt

  9.     myArray = Split(Sheets(1).Cells(i, 3), vbLf)
  10.     'j = i + 6
  11.     For j = 0 To UBound(myArray)
  12.     Sheets(2).Cells(i, 3).Value = myArray(j)
  13.     Next j
  14.     k = i + j
  15.     Sheets(2).Cells(k, 1) = Sheets(1).Cells(i, 1)
  16.     Sheets(2).Cells(k, 7) = Sheets(1).Cells(i, 7)
  17.     Sheets(2).Cells(k, 8) = Sheets(1).Cells(i, 8)
  18.     Next i
  19. End Sub
複製代碼




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