Új hozzászólás Aktív témák

• #46243 Mutt senior tag moma #46235

  Új Válasz 2021-03-12 09:39:17 #46243

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Mutt

  senior tag

  válasz moma #46235 üzenetére

  Szia,

  Abban kéne segítség, hogy az megcsinálható, hogy kijelölök egy oszlopban cellákat, amikben van szöveg, és szövegek elég tegyen be sorszámokat a kijelölt cellákba.

  Az alábbi makró tud segíteni, a kommentek alapján szerintem te is tudsz rajta igazítani.
  Beletettem egy plusz opciót hogy tömegesen el lehessen távolítani a sorszámot.

  Sub Sequencing()
Dim num As Long
Dim changedCells As Long
Dim selectionArea As Range
Dim currentCell As Range

'kijelölés megjegyzése
Set selectionArea = Selection

'beviteli mező hogy lehessen a sorszámot megadni
num = Application.InputBox(Prompt:="Kezdő sorszám (-1 esetén törli a sorszámot): ", Title:="Számozás", Default:=1, Type:=1)

'mégsem esetén álljunk le
If num = 0 Then
Exit Sub
End If

For Each currentCell In selectionArea
'csak olyan cellák érdekelnek amelyek nem üresek és képletet sem tartalmaznak
If currentCell.Value <> "" And currentCell.HasFormula = False Then
If num = -1 Then
'töröljük a cella elejéről a sorszámot ha van
currentCell.Value = RemoveTrailingNumbers(currentCell.Value)
changedCells = changedCells + 1
Else
'hozzáadjuk a sorszámot a cella elejére
currentCell.Value = num & ". " & currentCell.Value
num = num + 1
changedCells = changedCells + 1
End If
End If
Next currentCell

'visszajelzés
If changedCells = 0 Then
MsgBox "Nincs módosítás", vbOKOnly, "Számozás"
Else
MsgBox changedCells & " cella lett változtatva", vbOKOnly, "Számozás"
End If

End Sub

Function RemoveTrailingNumbers(s As String) As String
Dim regEx As Object
Set regEx = CreateObject("VBScript.RegExp")

'^ - csak a szöveg elején lévő dolgokat nézi
'\d+ - számjegy ami legalább egyszer megtalálható
'\. - pontot keresük
'\s* - whitespacet (szóköz, tab, sortörtés) keresünk
regEx.Pattern = "^\d+\.\s*"

RemoveTrailingNumbers = regEx.Replace(s, "")

End Function

  
  
  üdv

Új hozzászólás Aktív témák