S

Problem Makro
Nach Begriff in einer Spalte suchen Sub BegriffSuchen()
Dim gZelle As Range
Dim Msg1$, Msg2$, Msg3$, sBegriff$
Msg1 = "Bitte Suchbegriff eingeben:"
Msg2 = "Suchbegriff wurde nicht gefunden!"
Msg3 = "Suchbegriff befindet sich in Zelle "
sBegriff = InputBox(Msg1)
If sBegriff = "" Then Exit Sub
Set gZelle = Worksheets(1).Columns(1) _
.Find(sBegriff, lookat:=xlWhole)   'Tabelle1, Spalte 1
If gZelle Is Nothing Then
MsgBox Msg2
Else
MsgBox Msg3 & gZelle.Address(False, False)
End If
End Sub
Nach Begriff in mehreren Spalten suchen

- Sucht in 2 Spalten (frei definierbar)
- Sucht von unten nach oben ( Anleitung für Andersrum ist dabei)
- Sucht nach Rückfrage auch weiter
- die gefundene Zelle wird selektiert
- Groß-/Kleinschreibung ist egal

 Option Compare Text 'Anweisung Groß-/Kleinschreibung egal
Sub SuchenIn2Spalten()
Dim Sp1, Sp2, lZeile2, Such, Frage
Sp1 = 1 '1.Suchspalte
Sp2 = 4 '2.Suchspalte
'Ermittlung der absoluten letzten Zeile
lZeile2 = Cells(Rows.Count, 1).SpecialCells(xlLastCell).Row
Such = InputBox("Bitte geben Sie den Suchbegriff ein", "Suche")
If Such = "" Then Exit Sub
If IsNumeric(Such) Then Such = Such * 1
For i = lZeile2 To 1 Step -1
'Vorwärts: For i = 1 to lZeile2
If Cells(i, Sp1) = Such Then
Cells(i, Sp1).Select
Frage = MsgBox("Ist dies der gesuchte Eintrag?", vbYesNo)
If Frage = vbYes Then Exit Sub
End If
If Cells(i, Sp2) = Such Then
Cells(i, Sp2).Select
Frage = MsgBox("Ist dies der gesuchte Eintrag?", vbYesNo)
If Frage = vbYes Then Exit Sub
End If
Next i
MsgBox "Der gesuchte Eintrag wurde nicht gefunden"
End Sub
Speichern Unter mit Pfadvorgabe und vorgegebenem Dateinamen mit aktuellem Datum Sub SpeichernUnterDatum()
Dim DName, Dateiname, Pfad
Pfad = "C:\Temp"
DName = "Beispiel "
Dateiname = Pfad & "\" & DName & Format(Now, "YYYY.MM.DD") & ".xls"
'Tagesdatum als "Jahr.Monat.Tag" wegen Exploreransicht!
ThisWorkbook.SaveAs FileName:=Dateiname
End Sub
Speichern Unter mit Pfadauswahl und vorgegebenem Dateinamen Sub SpeichernUnterMitvoreingestelltemDateinamen()
ChDir ("C:\temp")
Application.Dialogs(xlDialogSaveAs).Show "C:\temp\test.xls"
End Sub
Speichernabfrage bei schließen mit Makro verhindern Workbooks(name.xls).Close SaveChanges:=False
Sonderzeichen Siehe Extraseite
Schriftarten auflisten von http://home.bip.net/kent.schederin/ (schwedisch)

Sub Schriftartenliste()
' Makro erzeugt in Tabelle mit Liste aller Schriftarten und der
' dazugehörigen Formatierung
Dim intRadnr As Integer, Teckenlista As Object
Set Teckenlista = Application.CommandBars("Formatting").FindControl(Id:=1728)
On Error Resume Next
Range("A:A").ClearContents
For intRadnr = 0 To Teckenlista.ListCount - 1
With Cells(intRadnr + 1, 1)
.Value = Teckenlista.List(intRadnr + 1)
.Font.Name = Teckenlista.List(intRadnr + 1)
End With
Next
End Sub
Von mir eingedeutscht und erweitert:

' Makro erzeugt in Tabelle mit Liste aller Schriftarten und der
' dazugehörigen Formatierung mit Mustertext
' 2. Spalte ist das Eurozeichen!
Sub SchriftartenlisteBert()
Dim Farbnr As Integer, Schriftliste As Object
Set Schriftliste = Application.CommandBars("formatting").FindControl(Id:=1728)
On Error Resume Next
[A:D].ClearContents
For Farbnr = 0 To Schriftliste.ListCount - 1
Cells(Farbnr + 1, 1).Value = Schriftliste.List(Farbnr + 1)
Cells(Farbnr + 1, 2).Value = "€"
Cells(Farbnr + 1, 3).Value = "abcdefghijklmnopqrstuvwxyzäöü"
Cells(Farbnr + 1, 4).Value = "ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ"
Cells(Farbnr + 1, 2).Font.Name = Schriftliste.List(Farbnr + 1)
Cells(Farbnr + 1, 3).Font.Name = Schriftliste.List(Farbnr + 1)
Cells(Farbnr + 1, 4).Font.Name = Schriftliste.List(Farbnr + 1)
[A:D].EntireColumn.AutoFit
Next
End Sub

Hier gibt es eine komplette Mustermappe mit Aktualisierung bei jeden Öffnen

aktive Spalte hervorheben
(keine sonstigen farbige Zellen möglich außer der bedingten Formatierung) 		'Makro im VBA-Editor in die betreffende Tabelle schreiben!

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Alle Farben in Tabelle löschen
Cells.Interior.ColorIndex = xlNone
'neue Zeile einfärben
Columns(Target.Column).Interior.ColorIndex = 34
End Sub
Spaltenbreite in Zentimeter festlegen

 

Siehe auch:
Zeilenhöhe in Zentimeter festlegen

 von Frank Arendt-Theilen:

Sub SpaltenbreiteInCm()
Dim sBreite As Single
Dim sAktuell As Single
Dim strText As String
Dim strAntwort As String
  sAktuell = (Selection.ColumnWidth + 0.71) / 5.1425
  strText = "Aktuelle Spaltenbreite: " & _
    Format(sAktuell, "###0.00 cm") & Chr(13) _
    & "Geben Sie die gewünschte Spaltenbreite für die " & _
    "aktuelle Spalte oder Markierung in cm ein:"
  strAntwort = InputBox(strText, "Neue Spaltenbreite festlegen", _
  Format(sAktuell, "###0.00"))
  If strAntwort <> "" Then
    sBreite = CSng(strAntwort)
    Selection.ColumnWidth = -0.71 + 5.1425 * sBreite
  End If
End Sub

Meine aktuellsten Exceltipps finden Sie hier: