Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Mit Makro doppelt unterstreichen

Forumthread: Mit Makro doppelt unterstreichen

Mit Makro doppelt unterstreichen
20.06.2008 19:53:24
Ralf
Hallo,
ich suche ein Makro, dass wenn in Zeile B2 ein "*" kommt in Zeile e2 die Zahl doppelt unterstrichen wird. Das Makro soll die Spalte B so bis ca. Zeile 5000 durchsuchen und wenn es fündig wird immer in gleicher Zeile in Spalte E doppelt unterstreichen. Wenn so was geht würde es meine Arbeit enorm erleichtern. Ich habe nicht viel Erfahrung mit der Erstellung von Makros.
Grüße und Danke für jede Unterstützung.
Ralf

Anzeige

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mit Makro doppelt unterstreichen
20.06.2008 20:23:00
Tino
Hallo Ralf,
teste mal diesen Code.
Sub Test() Dim A As Long Dim Bereich As Range, SBereich As Range, strAdress$ Application.ScreenUpdating = False Set Bereich = Range("B2:B10000") 'Suchbereich Bereich.Offset(0, 3).Font.Underline = xlNone For A = 1 To 10000 If A = 1 Then Set SBereich = Bereich.Find(What:="*", After:=Bereich(1), LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False) If Not SBereich Is Nothing Then strAdress$ = SBereich.Address SBereich.Offset(0, 3).Font.Underline = xlUnderlineStyleDouble End If Else Set SBereich = Bereich.FindNext(After:=SBereich) If SBereich.Address strAdress And Not SBereich Is Nothing Then SBereich.Offset(0, 3).Font.Underline = xlUnderlineStyleDouble Else Exit For End If End If Next A Application.ScreenUpdating = True End Sub


Gruß Tino

www.VBA-Excel.de


Anzeige
Korrektur etwas vergessen !!!!!!
20.06.2008 20:25:00
Tino

Sub Test()
Dim A As Long
Dim Bereich As Range, SBereich As Range, strAdress$
Application.ScreenUpdating = False
Set Bereich = Range("B2:B10000") 'Suchbereich
Bereich.Offset(0, 3).Font.Underline = xlNone
For A = 1 To 10000
If A = 1 Then
Set SBereich = Bereich.Find(What:="*", After:=Bereich(1), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If Not SBereich Is Nothing Then
strAdress$ = SBereich.Address
SBereich.Offset(0, 3).Font.Underline = xlUnderlineStyleDouble
Else
Exit For
End If
Else
Set SBereich = Bereich.FindNext(After:=SBereich)
If SBereich.Address  strAdress And Not SBereich Is Nothing Then
SBereich.Offset(0, 3).Font.Underline = xlUnderlineStyleDouble
Else
Exit For
End If
End If
Next A
Application.ScreenUpdating = True
End Sub


Anzeige
AW: Korrektur etwas vergessen !!!!!!
20.06.2008 21:10:00
Tino
Hallo,
habe meinen Code nochmal getestet war wohl ein Schnellschuss, vergiss diesen ganz schnell. Sorry
Andi hat eine funktionierende alternative.
Gruß Tino

AW: so jetzt aber die Makrolösung die funktioniert
21.06.2008 08:07:57
Tino
Hallo,
jetzt finktioniert dieses Makro, habe es auch getestet ;-)

Option Explicit
Sub Test()
Dim A As Long
Dim Bereich As Range, SBereich As Range, strAdress$
Application.ScreenUpdating = False
Set Bereich = Range("B2:B10000") 'Suchbereich
Bereich.Offset(0, 3).Font.Underline = xlNone
For A = 1 To 10000
If A = 1 Then
Set SBereich = Bereich.Find(What:="~*", After:=Bereich(1), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If Not SBereich Is Nothing Then
strAdress$ = SBereich.Address
SBereich.Offset(0, 3).Font.Underline = xlUnderlineStyleDouble
Else
Exit For
End If
Else
Set SBereich = Bereich.FindNext(After:=SBereich)
If SBereich.Address  strAdress And Not SBereich Is Nothing Then
SBereich.Offset(0, 3).Font.Underline = xlUnderlineStyleDouble
Else
Exit For
End If
End If
Next A
Application.ScreenUpdating = True
End Sub


Gruß Tino

Anzeige
AW: so jetzt aber die Makrolösung die funktioniert
21.06.2008 09:23:04
Ralf
Toll, das Makro funktioniert prima vielen vielen dank.
Kann man mit so einem Makro auch die Summen bestimmen? Immer der Zahlen oberhalb zwischen zwei "'*". Die Zahlen stehen alle in Zeile E. Da wo jetzt unterstrichen ist sollen dann die Summe stehen.

AW: so jetzt aber die Makrolösung die funktioniert
21.06.2008 16:19:00
Tino
Hallo,
mit Makro würde ich dies mittels einer Schleife machen.

Sub Test()
Dim A As Long
Dim Bereich(2) As Range
Application.ScreenUpdating = False
Columns(5).Font.Underline = xlNone
Columns(5).ClearContents
For A = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
If Cells(A, 2) = "*" And Bereich(1) Is Nothing Then
Set Bereich(1) = Cells(A, 2)
ElseIf Not Bereich(1) Is Nothing And Cells(A, 2) = "*" Or A = 2 Then
Set Bereich(2) = Range(CStr(Cells(A, 2).Address & ":" & Bereich(1).Address))
Bereich(1).Offset(0, 3) = Application.WorksheetFunction.Sum(Bereich(2))
Bereich(1).Offset(0, 3).Font.Underline = xlUnderlineStyleDouble
Set Bereich(1) = Nothing
Set Bereich(2) = Nothing
If A = 2 Then Exit For
A = A + 1
End If
Next A
Application.ScreenUpdating = True
End Sub


Gruß Tino

www.VBA-Excel.de


Anzeige
AW: so jetzt aber die Makrolösung die funktioniert
22.06.2008 01:08:00
Ralf
Hallo,
hab noch eine kleine Frage. Das Makro unterscheidet nicht ob "*" oder "**" und unterstreicht bei beiden. Kann man das ändern?
Grüße
Ralf

AW: so jetzt aber die Makrolösung die funktioniert
22.06.2008 02:13:35
Tino
Hallo,
so

Sub Test()
Dim A As Long
Dim Bereich(2) As Range
Application.ScreenUpdating = False
Columns(5).Font.Underline = xlNone
Columns(5).ClearContents
For A = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
If (Cells(A, 2) = "*" Or Cells(A, 2) = "**") And Bereich(1) Is Nothing Then
Set Bereich(1) = Cells(A, 2)
ElseIf Not Bereich(1) Is Nothing And (Cells(A, 2) = "*" Or Cells(A, 2) = "**") Or A = 2 Then
Set Bereich(2) = Range(CStr(Cells(A, 2).Address & ":" & Bereich(1).Address))
Bereich(1).Offset(0, 3) = Application.WorksheetFunction.Sum(Bereich(2))
Bereich(1).Offset(0, 3).Font.Underline = xlUnderlineStyleDouble
Set Bereich(1) = Nothing
Set Bereich(2) = Nothing
If A = 2 Then Exit For
A = A + 1
End If
Next A
Application.ScreenUpdating = True
End Sub


Gruß Tino

Anzeige
ohne Makro
20.06.2008 20:26:56
Andi
Hi,
mach das doch einfach mit bedingter Formatierung in Spalte E.
Formel (nicht Zellwert) ist:
=NICHT(ISTFEHLER(FINDEN("*";B2)))
Schönen Gruß,
Andi

Weitere Frage: Summe mit Makro
20.06.2008 22:24:18
Ralf
Danke für die schnelle Hilfe,
das mit der bedingten Formatierung ist echt klasse.
Gibt es sowas auch für die Summe? Alles wieder wie beschrieben "*" in B und in E soll die Summe gebildet werden. Immer bis zum nächsten "*" die Zwischensumme, oder geht hier nur ein Makro?
Grüße
Ralf

Anzeige
AW: Weitere Frage: Summe mit Makro
20.06.2008 22:30:01
Josef
Hallo Ralf,
meinst du so?
Tabelle3

 ABCDEF
1 Wert  ZS 
2 458    
3 430    
4 151    
5 *  1039 
6 438    
7 404    
8 194    
9 334    
10 457    
11 *  1827 
12 336    
13 107    
14 239    
15 278    
16 *  960 
17 431    
18 229    
19 326    
20 439    
21 *  1425 
22 174    
23 256    
24 242    
25 169    
26 210    
27 194    
28 393    
29 *  1638 
30 435    
31 367    
32 234    
33 216    
34 *  1252 
35      

Formeln der Tabelle
ZelleFormel
E2=WENN(B2="*";SUMME($B$2:B2)-SUMME($E$1:E1); "")
Excel Tabellen im Web darstellen  Excel Jeanie HTML

Gruß Sepp



Anzeige
AW: Weitere Frage: Summe mit Makro
21.06.2008 07:55:44
Ralf
Die Zahlen stehen in Spalte E daher kann ich hier keine Formel runterkopieren
;
Anzeige
Anzeige

Infobox / Tutorial

Mit Makro in Excel doppelt unterstreichen und Summen bilden


Schritt-für-Schritt-Anleitung

  1. Öffne Excel und drücke ALT + F11, um den VBA-Editor zu öffnen.
  2. Gehe zu Einfügen > Modul, um ein neues Modul zu erstellen.
  3. Kopiere den folgenden Code in das Modul:
Sub DoppeltUnterstreichen()
    Dim A As Long
    Dim Bereich As Range, SBereich As Range, strAdress$
    Application.ScreenUpdating = False
    Set Bereich = Range("B2:B5000") 'Suchbereich
    Bereich.Offset(0, 3).Font.Underline = xlNone
    For A = 1 To 5000
        If A = 1 Then
            Set SBereich = Bereich.Find(What:="*", After:=Bereich(1), LookIn:=xlValues, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
            SearchFormat:=False)
            If Not SBereich Is Nothing Then
                strAdress$ = SBereich.Address
                SBereich.Offset(0, 3).Font.Underline = xlUnderlineStyleDouble
            End If
        Else
            Set SBereich = Bereich.FindNext(After:=SBereich)
            If SBereich.Address <> strAdress And Not SBereich Is Nothing Then
                SBereich.Offset(0, 3).Font.Underline = xlUnderlineStyleDouble
            Else
                Exit For
            End If
        End If
    Next A
    Application.ScreenUpdating = True
End Sub
  1. Schließe den VBA-Editor und kehre zu Excel zurück.
  2. Drücke ALT + F8, wähle das Makro DoppeltUnterstreichen aus und klicke auf Ausführen.

Häufige Fehler und Lösungen

  • Fehler: Makro funktioniert nicht.

    • Lösung: Stelle sicher, dass die Makros in den Excel-Einstellungen aktiviert sind.
  • Fehler: Unterstreichungen werden nicht korrekt gesetzt.

    • Lösung: Überprüfe den Suchbereich im VBA-Code und stelle sicher, dass er auf die richtige Zeile verweist (z.B. B2:B5000).

Alternative Methoden

Wenn Du kein Makro verwenden möchtest, kannst Du die bedingte Formatierung nutzen:

  1. Wähle die Zellen in Spalte E aus.
  2. Gehe zu Start > Bedingte Formatierung > Neue Regel.
  3. Wähle Formel zur Ermittlung der zu formatierenden Zellen verwenden.
  4. Gib die Formel ein:
    =NICHT(ISTFEHLER(FINDEN("*";B2)))
  5. Setze die Formatierung auf „Unterstreichen“.

Praktische Beispiele

  1. Doppelt unterstreichen: Wenn in Zelle B2 ein * steht, wird in E2 die Zahl doppelt unterstrichen.
  2. Summenbildung: Bei Verwendung des Makros zur Summenbildung wird die Summe der Zahlen in Spalte E zwischen zwei *-Zeichen berechnet und unterstrichen.
Sub SummenBildung()
    Dim A As Long
    Dim Bereich(2) As Range
    Application.ScreenUpdating = False
    Columns(5).Font.Underline = xlNone
    Columns(5).ClearContents
    For A = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
        If Cells(A, 2) = "*" And Bereich(1) Is Nothing Then
            Set Bereich(1) = Cells(A, 2)
        ElseIf Not Bereich(1) Is Nothing And Cells(A, 2) = "*" Or A = 2 Then
            Set Bereich(2) = Range(CStr(Cells(A, 2).Address & ":" & Bereich(1).Address))
            Bereich(1).Offset(0, 3) = Application.WorksheetFunction.Sum(Bereich(2))
            Bereich(1).Offset(0, 3).Font.Underline = xlUnderlineStyleDouble
            Set Bereich(1) = Nothing
            Set Bereich(2) = Nothing
        End If
    Next A
    Application.ScreenUpdating = True
End Sub

Tipps für Profis

  • Nutze die Option Explicit-Anweisung am Anfang deines Moduls, um sicherzustellen, dass Du alle Variablen deklariert hast.
  • Überlege, ob du auch doppelt unterstreichen in Word benötigst, um die gleichen Makro-Techniken dort anzuwenden.
  • Teste den Code immer in einer Kopie deiner Arbeitsmappe, um Datenverluste zu vermeiden.

FAQ: Häufige Fragen

1. Was bedeutet 100 doppelt unterstrichen?
Das bedeutet, dass in Excel die Zahl 100 durch einen doppelten Unterstrich hervorgehoben wird, was oft zur Betonung dient.

2. Kann ich das Makro auch in Word verwenden?
Ja, ähnliche VBA-Code-Logiken können auch in Word verwendet werden, um Text doppelt zu unterstreichen, jedoch sind die spezifischen Objekte und Methoden unterschiedlich.

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige