Tak for tilbagemeldingen!
Ja, du ville jo nok have haft "fast arbejde" i et stykke tid
Resultatet af en makro kan ikke fortrydes med fortrydknappen
(eller <Ctrl>z), så hvis "katastrofen" skulle indtræffe, og du kom
til at køre rutinen to (eller flere) gange på de samme navne
(eller blot ville tilbage til den oprindelige opstilling), så vidste
du pludselig, hvad du skulle få de næste dage (uger)
til at gå med
For at forhindre denne situation har jeg lavet en fortrydelses-
rutine. Trykker du fx 6 gange på "Ombyt", skal du blot trykke 6
gange på "FortrydOmbyt" osv., og du er tilbage ved udgangs-
punktet.
Samtidig har jeg lavet lidt om på den originale rutine, så man
nu kan køre den på ord, hvor adskillelsestegnet er et andet
end mellemrum (SeparatorChar). Læg mærke til, at der nu ikke
er noget mellemrum (eller andet SeparatorChar) i DelimitChar.
(Med mindre du altså explicit ønsker, at DelimitChar skal bestå af flere
tegn)
--
Med venlig hilsen
Leo Heuser
OmbytNavne()
'Leo Heuser, 28-6-2002
'Virker kun i Excel 2000 og frem
Dim Counter As Long
Dim DelimitChar As String
Dim FirstRow As Long
Dim Rev1 As String
Dim Rev2 As String
Dim RevSearchData As String
Dim SearchColumn As String
Dim SearchRange As Range
Dim SearchData As Variant
Dim SeparatorChar As String
On Error Resume Next
' SearchColumn = "A"
' FirstRow = 1
SeparatorChar = " " 'Tegnet mellem ordene (her mellemrum)
DelimitChar = ","
With ActiveCell
SearchColumn = Split(.Address, "$")(1)
FirstRow = .Row
End With
Set SearchRange = Range(Range(SearchColumn & FirstRow), _
Range(SearchColumn & 65536).End(xlUp))
SearchData = SearchRange.Value
DelimitChar = DelimitChar & SeparatorChar
For Counter = 1 To UBound(SearchData, 1)
If Not IsEmpty(SearchData(Counter, 1)) Then
RevSearchData = StrReverse(SearchData(Counter, 1))
Rev1 = Left$(RevSearchData, _
InStr(RevSearchData, SeparatorChar) - 1)
Rev2 = Mid$(RevSearchData, _
InStr(RevSearchData, SeparatorChar) + 1)
SearchData(Counter, 1) = StrReverse(Rev1) & _
DelimitChar & StrReverse(Rev2)
End If
Next Counter
SearchRange.Value = SearchData
End Sub
Sub FortrydOmbytNavne()
'Leo Heuser, 28-6-2002
'Virker kun i Excel 2000 og frem
Dim Counter As Long
Dim DelimitChar As String
Dim FindDelimitChar As Long
Dim FirstRow As Long
Dim LeftPart As String
Dim RightPart As String
Dim SearchColumn As String
Dim SearchRange As Range
Dim SearchData As Variant
Dim SeparatorChar As String
On Error Resume Next
' SearchColumn = "A"
' FirstRow = 1
SeparatorChar = " " ' Tegnet mellem ordene (her mellemrum)
DelimitChar = ","
With ActiveCell
SearchColumn = Split(.Address, "$")(1)
FirstRow = .Row
End With
Set SearchRange = Range(Range(SearchColumn & FirstRow), _
Range(SearchColumn & 65536).End(xlUp))
SearchData = SearchRange.Value
DelimitChar = DelimitChar & SeparatorChar
For Counter = 1 To UBound(SearchData, 1)
FindDelimitChar = InStr(SearchData(Counter, 1), DelimitChar)
If FindDelimitChar > 0 Then
LeftPart = _
Left$(SearchData(Counter, 1), FindDelimitChar - 1)
RightPart = _
Mid$(SearchData(Counter, 1), FindDelimitChar + _
Len(DelimitChar))
SearchData(Counter, 1) = _
RightPart & SeparatorChar & LeftPart
End If
Next Counter
SearchRange.Value = SearchData
End Sub
"Michael Lund Sørensen" <hold-diskussionen-i@nyhedsgruppen-tak.dk> skrev i
en meddelelse news:ZAoS8.9834$va.918172@news000.worldonline.dk...
> Som sædvanligt virkede det bare perfekt !
> 10.000 navne på et sekund! Hvor lang tid ville det ikke have taget mig?
>
> --
> Hilsen
> Michael Lund Sørensen
>
www.milux.dk.sletdette
>
>
>