Extraia todas as URLs do arquivo CSV / Excel e coloque-as em uma coluna separada

0

Eu tenho um arquivo csv. Quando eu abro o arquivo csv no Microsoft Excel, eu tenho uma coluna.

Cada célula na coluna tem número de parágrafos. cada parágrafo tem muitos URLs.

Estou procurando extrair todos os URLs em cada célula da coluna e colocar cada URL em uma célula separada em uma nova coluna separada.

Todos os URLs começam com http: // e terminam com .jpg

Como posso fazer isso no Excel ou no Notepad ++?

Obrigado antecipadamente

    
por Ali_2017 21.02.2017 / 13:19

1 resposta

0

Aqui está um código que dividirá as células com alimentação de linha em colunas. Você deve ser capaz de ajustá-lo dependendo de como seus parágrafos se parecem.

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
    
por 21.02.2017 / 21:35