☰

从 CSV/Excel 文件中提取所有 URL 并将其放在单独的列中

tag-icon • tag-icon microsoft-excel notepad++ csv url
从 CSV/Excel 文件中提取所有 URL 并将其放在单独的列中

我有一个 csv 文件。当我在 Microsoft Excel 中打开该 csv 文件时，我有一列。

列中的每个单元格都有多个段落。每个段落有许多 URL。

我希望提取列中每个单元格中的所有 URL，并将每个 URL 放在新单独列中的单独单元格中。

所有 URL 均以 http:// 开头，以 .jpg 结尾

我如何在 Excel 或 Notepad++ 中执行此操作

先感谢您

答案1

这是将带有换行符的单元格拆分为列的代码。您应该能够根据段落的外观对其进行调整。

Sub SplitCellsAndExtend_New()
'takes cells with inside line feeds and creates new row for each.
'reverses merge into top cell.

'turn off updates to speed up code execution
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With


Dim strCell As String, lastRow As Long, lRowLoop As Long, j As Long, arSplit
Application.ScreenUpdating = False

Const lColSplit As Long = 4
Const sFirstCell As String = "A1"
Dim sSplitOn As String
sSplitOn = Chr(10)

lastRow = Cells(Rows.Count, lColSplit).End(xlUp).Row

    For lRowLoop = lastRow To 1 Step -1

        arSplit = Split(Cells(lRowLoop, lColSplit), sSplitOn)

        If UBound(arSplit) > 0 Then
            Rows(lRowLoop + 1).Resize(UBound(arSplit) + 1).Insert

            Cells(lRowLoop, lColSplit).Resize(, UBound(arSplit) + 1).Value = arSplit
            Cells(lRowLoop, lColSplit).Resize(, UBound(arSplit) + 1).Copy
            Cells(lRowLoop + 1, lColSplit).PasteSpecial Transpose:=True

            Cells(lRowLoop, 1).Resize(, lColSplit - 1).Copy Cells(lRowLoop + 1, 1).Resize(UBound(arSplit) + 1)

            Rows(lRowLoop).Delete
        End If

        Set arSplit = Nothing
    Next


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With


End Sub

相关内容