Textsatz mit \LaTeX, Programmieren, Zahlen, etc.
Archive for the ‘MS Office & VBA’ Category.
Text lässt sich „einfach“ umkehren in Excel, auch ohne VBA.
Wenn der umzukehrende Text in Zelle A1 steht, dann hilft die folgende Formel
=TEXTVERKETTEN("";WAHR;TEIL(A1;LÄNGE(A1)-ZEILE(INDIREKT("1:"&LÄNGE(A1)))+1;1))
Mit Strg-Shift-Enter abschließen, um eine Array-Formel zu erstellen.
Über eine Verknüpfung auf die Rundll32.exe kann man flink in den Energiesparmodus von Windows wechseln.
In irgendeinem Ordner (z.B. auf dem Desktop) rechte Maustaste => neu => Verknüpfung. Als Speicherort des Elements dann folgendes eingeben:
C:\Windows\System32\rundll32.exe powrprof.dll,SetSuspendState
Vor ein paar Wochen hat jemand in einer Facebook-Gruppe gefragt, wie man — abhängig von einer Soll/Haben-Spalte — in Excel einen Wert mit positivem oder negativem Vorzeichen darstellen kann. Die Lösung ist ganz einfach, wenn man die WENN() Funktion kennt.
Spannender ist die Frage: Geht es auch ohne Wenn() und ohne VBA? Die Antwort ist ja, von hinten durch die Brust ins Auge…
Mittels CODE() Funktion ermitteln wir den ASCII Code des Buchstabens, bei „S“ ist das 83, bei „H“ 72.
Als nächstes ziehen wir von diesem Wert 84 ab und vergleichen den Wert mit -1. Excel wertet dies für „S“ als WAHR aus, für „H“ als FALSCH. Da man mit WAHR (=1) und FALSCH (=0) prima in Excel weiterrechnen kann, multiplizieren wir den Wert mit -2 und addieren 1.
Für „S“ ergibt sich 1 (für „WAHR“) * -2 = -2 + 1 = 1, für „H“ ergibt sich 0 (für „FALSCH“) * -2 = 0 + 1 = 1. Damit muss man dann nur noch den ursprünglichen Betrag multiplizieren…
Die Uhr rechts unten in der Windows-Taskleiste kann man auch so einstellen, dass die Sekunden angezeigt werden
Dazu mit regedit den Schlüssel \HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced –> ShowSecondInSystemClock auf 1 setzen.
Nachdem wir bereits mit Excel und VBA Platzhalter in CSV Dateien gesucht und mit Inhalten ersetzt haben heute das ganze mit Python und OpenPyxl.
Ausgangspunkt ist eine Exceldatei „python_test.xlsx“ mit einer Named Range „Felder“ im Tabellenblatt „Tabelle2“.
Mit der openpyxl Bibliothek laden wir das Excel-Blatt und holen uns die Inhalte der Range in ein Dictionary. Jeden der Keys aus dem Dictionary suchen wir dann in der CSV Datei und ersetzen ihn gegen den Wert aus der Excel-Datei.
# -*- coding: utf-8 -*- import openpyxl path = "python_test.xlsx" workbook = openpyxl.load_workbook(path) def get_sheet_and_location(workbook, named_range): x = list(workbook.defined_names['Felder'].destinations)[0] return x[0], x[1].replace('$','').split(':')[0],x[1].replace('$','').split(':')[1] sheet, start, stop = get_sheet_and_location(workbook,'Felder') worksheet = workbook[sheet] rng=worksheet[start:stop] replacements = {} for row in rng: c1, c2 = row replacements[c1.value] = c2.value with open('Python_test.txt') as input_file: text = input_file.read() for key in replacements: text = text.replace(key,str(replacements[key])) with open('Python_test_output.txt','w') as output_file: output_file.write(text) |
Basierend auf meinem letzten Artikel zum Thema Excel und CSV hier ein kurzes Beispiel, wie man aus Excel heraus Daten in ziemlich beliebigem Format (hier Komma als Spaltentrenner, Punkt als Dezimalzeichen) exportieren kann.
Ausgangspunkt ist eine kleine Excel-Datei mit vier Spalten und drei Zeilen.
Der VBA Code, adaptiert von excel-easy.com und codevba.com, exportiert diese in eine CSV Datei (im ANSI-Encoding), wenn der Spalten-Index der exportierten Spalte kleiner ist als die Breite der Range, dann wird ein Komma nach der Spalte eingefügt, sonst (am Ende der Range) ein Zeilenumbruch.
Option Explicit
Sub Schaltfläche1_Klicken()
Dim fso, f, currentColumn
Dim rng As Range, cell As Range
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("E:\SearchReplaceVBA\export.csv", 2, True)
' https://www.excel-easy.com/vba/examples/loop-through-defined-range.html
' http://codevba.com/excel/for_each_cell_in_range.htm
Set rng = Sheets(1).Range("A1:D3")
For Each cell In rng.Cells
With cell
' Debug.Print .Address & ":" & .Value & ":" & .Row & ":" & .Column
currentColumn = .Column
f.write (Replace(.Value, ",", "."))
If currentColumn < rng.Columns.Count Then
f.write (",")
Else
f.write (vbNewLine)
End If
End With
Next cell
End Sub |
Ergebnis
Feld A,Feld B,Feld C,Feld D 88.4599201649139,9.76226327089422,AAA,45.4279124487558 22.6480222965468,82.5612661495282,BBB,96.7699232025441
Heute mal mal mit Excel und VBA. Ziel ist es, in einer Textdatei (komma-separiert, Punkt als Dezimalzeichen) Platzhalter durch Werte zu ersetzen, ohne dass die Datei dabei von Excel kaputt „optimiert“ wird.
Die Excel-Datei sieht dabei so aus:
Einfach nur ein paar Werte untereinander, Dezimaltrenner ist das Komma.
CSV-Quelldatei „Quelle.csv“:
SpalteA,SpalteB,SpalteC FeldA,WertA,1.12 FeldB,WertB,1.23 FeldC,WertC,1.34 FeldD,WertD,1.45 FeldE,WertE,1.56 FeldF,WertF,1.67 FeldG,WertG,1.78 FeldH,WertH,1.89 FeldI,WertI,1.90 FeldJ,WertJ,1.95
Hinter dem Buttom im Excel liegt der folgende VBA/VBS Code, den ich bei http://www.office-loesung.de gefunden und adaptiert habe.
Option Explicit
Sub Schaltfläche1_Klicken()
Dim fso, f, text
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("E:\SearchReplaceVBA\Quelle.csv", 1)
text = f.ReadAll
text = Replace(text, "WertA", Replace(Cells(2, 3).Value, ",", "."))
text = Replace(text, "WertB", Replace(Cells(3, 3).Value, ",", "."))
text = Replace(text, "WertC", Replace(Cells(4, 3).Value, ",", "."))
text = Replace(text, "WertD", Replace(Cells(5, 3).Value, ",", "."))
text = Replace(text, "WertE", Replace(Cells(6, 3).Value, ",", "."))
text = Replace(text, "WertF", Replace(Cells(7, 3).Value, ",", "."))
text = Replace(text, "WertG", Replace(Cells(8, 3).Value, ",", "."))
text = Replace(text, "WertH", Replace(Cells(9, 3).Value, ",", "."))
text = Replace(text, "WertI", Replace(Cells(10, 3).Value, ",", "."))
f.Close
Set f = fso.OpenTextFile("E:\SearchReplaceVBA\Ziel.csv", 2, True)
f.Write (text)
f.Close
End Sub |
Das Ergebnis „Ziel.csv“ sieht dann so aus:
SpalteA,SpalteB,SpalteC FeldA,2.9502085126608,1.12 FeldB,73.1026744983578,1.23 FeldC,55.250551974564,1.34 FeldD,33.2285937834519,1.45 FeldE,42.2559662206547,1.56 FeldF,24.6506686140567,1.67 FeldG,54.0201369859298,1.78 FeldH,26.9352342768415,1.89 FeldI,51.1782693678183,1.90 FeldJ,87.9325752371774,1.95
Es geht natürlich noch viel eleganter, indem man zum Beispiel Ranges nutzt, als Proof-of-Concept reicht dies jedoch schon aus.
Mit named Ranges würde die Lösung so aussehen:
Option Explicit
Sub Schaltfläche1_Klicken()
Dim fso, f, text
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("E:\SearchReplaceVBA\Quelle.csv", 1)
text = f.ReadAll
text = Replace(text, "WertA", Replace(Range("FeldA").Value, ",", "."))
text = Replace(text, "WertB", Replace(Range("FeldB").Value, ",", "."))
text = Replace(text, "WertC", Replace(Range("FeldC").Value, ",", "."))
text = Replace(text, "WertD", Replace(Range("FeldD").Value, ",", "."))
text = Replace(text, "WertE", Replace(Range("FeldE").Value, ",", "."))
text = Replace(text, "WertF", Replace(Range("FeldF").Value, ",", "."))
text = Replace(text, "WertG", Replace(Range("FeldG").Value, ",", "."))
text = Replace(text, "WertH", Replace(Range("FeldH").Value, ",", "."))
text = Replace(text, "WertI", Replace(Range("FeldI").Value, ",", "."))
text = Replace(text, "WertJ", Replace(Range("FeldJ").Value, ",", "."))
f.Close
Set f = fso.OpenTextFile("E:\SearchReplaceVBA\Ziel.csv", 2, True)
f.Write (text)
f.Close
End Sub |
Hier ein anschauliches Beispiel für die Nutzung der Und() und Oder() Formel in Excel.
Gesucht werden die Zeilen, in denen Spalte A gleiche Werte aufweist, in Spalte B jedoch nicht.
Die Lösung dafür liegt in einer verschachtelten Und()/Oder() Funktion, schauen wir uns das mal für die Zeile 6 an:
Ich suche die Zeilen, in denen der Wert von Spalte A (also A6) dem Wert der vorigen Zeile (also A5) entspricht UND gleichzeitig der Wert aus Spalte B nicht dem Wert aus der vorigen Zelle entspricht.
Dies resultiert in der Formel: UND(A6=A5;B6<>B5)
Ich muss jedoch nicht nur die vorherige Zeile prüfen, sondern auch die folgende. Analog Prüfung auf die vorherige Zeile ergibt sich: UND(A6=A7;B6<>B7)
Da ich die Zeilen suche, in der die eine oder die andere Bedingung gilt, verpacke ich die beiden Formeln in eine Oder() Funktion: =ODER(UND(A6=A5;B6<>B5);UND(A6=A7;B6<>B7)). Das Oder() ist dabei nicht exklusiv, es können auch beide Teile WAHR ergeben, damit die Oder() Funktion ein WAHR zurückgibt. (Für unseren Zweck ist das egal, bei drei in Spalte A gleichen/in Spalte B ungleichen Zeilen könnte das einen Unterschied machen)
Ich muss gelegentlich eine Access-Datenbank umziehen lassen, die auf diverse verlinkte Datenbanken zugreift (um das 2 GB Maximum zu umgehen). Da die Verlinkungen absolut sind und nicht relativ, muss man jede Verlinkung nach dem Umzug manuell anpassen, was bei mehr als 100 Tabellen mühselig und fehlerträchtig ist. Basierend auf Code von Stackexchange/Stackoverflow habe ich daher ein paar Hilfsfunktionen gebaut, die den Umzug deutlich vereinfachen. Die Annahme
Der Code besteht aus mehreren Funktionen:
getDatabaseName() extrahiert den Namen der Datenbank aus dem Pfad GetFolder()fragt beim Nutzer den Pfad ab, in dem die neuen Datenbank-Dateien liegen.
verlinkeTabellenNeu() biegt die Links auf die Datenbankdateien umHinweis: Es empfiehlt sich nach Abschluss ein Auslesen aller Verlinkungen und Abgleichen z.B. in Excel, um auf Nummer sicher gehen zu können, dass alle Verlinkungen erfolgreich waren. Zum Auslesen der Verlinkungen kann man den Code unten am Ende des Artikels nutzen.
Option Compare Database
Function getDatabaseName(currentPath As String)
' Uwe Ziegenhagen, 2017-11-03
' Extrahiert den Namen der Datenbank aus dem Pfad,
' wertet dazu die Position des letzten "\" aus:
' von innen nach außen:
' kehre String um
' finde den letzten Backslash
' nimm den substring bis zum letzten Backslash
' reverse diesen Substring wieder
getDatabaseName = StrReverse(Left(StrReverse(currentPath), InStr(StrReverse(currentPath), "\") - 1))
End Function
Function GetFolder() As String
' https://stackoverflow.com/questions/26392482/vba-excel-to-prompt-user-response-to-select-folder-and-return-the-path-as-string
' based on https://www.ozgrid.com/forum/forum/help-forums/excel-general/126180-getfolder-function?t=182343
' requires references to Microsoft Office xx.0 Object library
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
'.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
Sub verlinkeTabellenNeu()
' Uwe Ziegenhagen, 2017-11-03
' Ruft vom User einen Pfad ab und verlinkt alle Tabellen mit diesem Pfad neu
' based on code from https://stackoverflow.com/questions/4928134/changing-linked-table-location-programatically
ordnerNeu = GetFolder()
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Set dbs = CurrentDb()
With dbs
For Each tdf In .TableDefs
'Is the table a linked table?
If tdf.Attributes And dbAttachedODBC Or tdf.Attributes And dbAttachedTable Then
With tdf
oldPath = .Properties("Connect").Value
.Connect = ";DATABASE=" & ordnerNeu & "\" & getDatabaseName(.Properties("Connect").Value)
.RefreshLink
Debug.Print oldPath & "@@@" & .Properties("Connect").Value
End With
End If
Next tdf
End With
End Sub |
Code zum Auslesen der Verlinkungen
Sub LinkedTableConnection()
' http://p2p.wrox.com/access-vba/37117-finding-linked-tables.html
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Set dbs = CurrentDb()
With dbs
For Each tdf In .TableDefs
'Is the table a linked table?
If tdf.Attributes And dbAttachedODBC Or tdf.Attributes And dbAttachedTable Then
With tdf
' Connect property contains path of link
' Debug.Print "Connect Property of " & .Name & " is: " & .Properties("Connect").Value
Debug.Print "kompletter Pfad: " & tdf.Connect
' Debug.Print "Name der Datenbank: " & getDatabaseName(.Properties("Connect").Value)
End With
End If
Next tdf
End With
End Sub |
Hier ein wenig VBA, um Excel-Blätter zu leeren:
Sub clearthisSheet()
With Sheets("Tabelle1")
.Cells.Clear
End With |