将内容移动到一列中分隔单元格

最近，我得到了一个大表来重新格式化。我对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

将内容移动到一列中分隔单元格

回答

相关问题