venerdì 19 aprile 2013

m estrai primo spazio dx

Attribute VB_Name = "m_estrai_primo_spazio_dx"

'

Option Explicit

'

'vba - excel

' Estrae Stringa Dopo il primo spazio a destra

'

'

Sub EstraeStringaDopoilPrimoSpazioDestra()

Dim quanterighe, contarighe, foglio, contenuto1, contenuto2, colonnadascansionare, scrivicolonna, presente

Set foglio = Sheets(ActiveSheet.Name)

'

quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).Row

colonnadascansionare = ActiveCell.Column ' prende la colonna della cella attiva

scrivicolonna = colonnadascansionare + 1 ' colonna dove scrivere il valore trovato

'

contarighe = 1

While contarighe <= quanterighe

contenuto1 = Trim(foglio.Cells(contarighe, colonnadascansionare).Value)

contenuto2 = Trim(foglio.Cells(contarighe, scrivicolonna).Value)

presente = InStr(contenuto1, " ")

If presente > 0 Then

If Len(contenuto2) > 0 Then

ActiveSheet.Cells(contarighe, colonnadascansionare).Value = "'" & Trim(Left(contenuto1, presente))

ActiveSheet.Cells(contarighe, scrivicolonna).Value = "'" & contenuto2 & Trim(Mid(contenuto1, (presente + 1), (Len(contenuto1) - presente)))

Else

ActiveSheet.Cells(contarighe, colonnadascansionare).Value = "'" & Trim(Left(contenuto1, presente))

ActiveSheet.Cells(contarighe, scrivicolonna).Value = "'" & Trim(Mid(contenuto1, (presente + 1), (Len(contenuto1) - presente)))

End If

End If

contarighe = contarighe + 1

Wend

'

End Sub

'









'

Nessun commento:

Posta un commento