將內容移動到一列中分隔單元格

最近，我得到了一個大表來重新格式化。我對vba不是很熟悉，但我知道一些東西，並盡我所能。將內容移動到一列中分隔單元格

它有一個列有電話號碼，一些電子郵件地址和網站。

我給你提供了一個小例子，它是怎麼回事，它應該如何，以及我走了多遠。

正如你可以看到我插入兩列Id後更名爲頭Phone number，E-Mails和Website。移動號碼並不是很難，但我在移動電子郵件地址和網站時很費力。

在原始片Id，Phone number，...是在左上角（Id A1，B1 Phone number，...）

有該文件中沒有空行。通過查看單元格是否包含@來查找電子郵件地址和網站之間的區別。這將是巨大的，如果有人可以幫助我

2016-08-02 Nico T

我們很難幫助，如果我們看不到代碼。記住在你的問題中編輯它？至於檢查@符號，你可以做一些像'InStr（ADDRESS_TO_CHECK，「@」）'（Instr docs：https：//msdn.microsoft.com/en-us/library/8460tsh1(v=vs.90 ）.aspx） – Mikegrann

我會使用像Instr（1，ADDRESS_TO_CHECK，「www」）這樣的網站，因爲你的電話號碼也會通過@檢查。你到目前爲止是否嘗試過任何代碼？ –

請發佈您到目前爲止的代碼。此外，它看起來像你的數據[電話號碼]，[電子郵件]，[網站]。它總是**會變成這樣嗎？或者你可以混合使用，如[電話號碼]，[網站]，[電子郵件]，[網站]？ – BruceWayne

Sub RearangeWorkSheet2() 
    Const IDColumn = 1 
    Dim arrData() 
    Dim i As Long, j As Long, RecordID As Long, lastRow As Long, x As Long, y As Long 

    lastRow = Range("B" & Rows.Count).End(xlUp).row 
    ReDim arrData(3, 0) 

    For x = 2 To lastRow 
     If Cells(x, 1) <> "" Then 
      RecordID = i 
      ReDim Preserve arrData(3, i) 
      arrData(0, RecordID) = Cells(x, 1) 
      i = i + 1 
     End If 

     If IsNumeric(Left(Cells(x, 2), 3)) Then 
      y = 1 
     ElseIf InStr(Cells(x, 2), "@") Then 
      y = 2 
     Else 
      y = 3 
     End If 

     For j = RecordID To UBound(arrData, 2) 

      If IsEmpty(arrData(y, j)) Or j = UBound(arrData, 2) Then Exit For 

     Next 

     If Not IsEmpty(arrData(y, j)) Then 
      ReDim Preserve arrData(3, i) 
      i = i + 1 
      j = j + 1 
     End If 

     arrData(y, j) = Cells(x, 2) 
    Next 

    Worksheets("Sheet1").Range("D2").Resize(UBound(arrData, 2) + 1, 4).Value = WorksheetFunction.Transpose(arrData) 

End Sub

來源

2016-08-02 17:29:02

謝謝@Thomas Inzina。它像一個魅力 –

感謝您的複選標記！ – 2016-08-03 08:15:14

將內容移動到一列中分隔單元格

回答

相關問題