Hallo Micha,
ich habe mal ein kleines Makro (s.u.) geschrieben, welches das von Dir
skizzierte Problem löst.
Da hier in den Liste-Mails die Makro-Layouts immer "versaubeutelt"
werden an "Cc: michaku...@habmalnefrage.de" die Dateianhänge:
+ "Name_Gruppe.txt" (Makro)
+ "Name_Gruppe.ods" (CALC-Beispieltabellen)
[1] Das 'Tabellenblatt 1' kann beliebig viele 'Gruppe'-Spalten
beinhalten, wobei Du die Gruppen-Namen frei wählen kannst, muss also
nicht "Gruppe 1", "Gruppe 2" ... sein.
[2] Das 'Tabellenblatt 1' kann beliebig viele Zeilen enthalten.
[3] Die Tabellenblätter kannst Du auch umbenennen, da die
Tabellenblätter über Indizes angesprochen werden, müssen also nicht
"Tabellenblatt 1" und Tabellenblatt 2" heißen.
[4] Der Wahrheitswert sollte von der Art 'Zeichen' sein. Wenn Du
beispielsweise anstatt "x" als Wahrheitswert "ja" haben möchtest, musst
Du im Makro folgende Zeile anpassen: Const WD = "x" => Const WD = "ja"
[5] Das SORTIEREN habe ich mir im Makro gespart, sind manuell eh nur
wenige MausKlicks:
+ TB2 markieren Spalte "B"
+ [Daten]->[Sortieren]->[Erweiterte Auswahl]->[OK]
Und falls Dein Interesse an Makro-Programmierung "geweckt" worden sein
sollte, hier findest Du Informationen:
StarBasic/OpenOffice.org Basic FAQ (einfache Beispiele zum direkten
Ausprobieren)
http://www.dannenhoefer.de/faqstarbasic/index.html
BASIC-Makros für OpenOffice und LibreOffice (umfassendes "Standardwerk",
manchmal nicht ganz leicht verständlich, inklusive Beispiele)
www.uni-due.de/~abi070/count.php?id=OOME_3_0_deutsch.odt
www.uni-due.de/~abi070/count.php?id=OOME_3_0_deutsch.pdf
Makro Grundlagen Band 1
https://www.tintal.de/index.php/buecher/fbuecher/31746-makro-grundlagen-band-1
Makro Grundlagen Band 2
https://www.tintal.de/index.php/buecher/fbuecher/31747-makro-grundlagen-band-2
Makro Kochbuch
https://www.tintal.de/index.php/buecher/fbuecher/31737-makro-kochbuch
Wenn noch Fragen, lass einfach hören ..
Viele Grüße
Hans-Werner :-))
==================== MAKRO ====================
Option Explicit
Sub Name_Gruppe
Dim aGN() As String ' arr Gruppen Namen
Dim iTB As Integer ' idx Tabellen Blatt
Dim oCur As Object ' obj Cursor
Dim oCD As Object ' obj CALC Dokument
Dim oTB1 As Object ' obj Tabellen Blatt 1
Dim oTB2 As Object ' obj Tabellen Blatt 2
Dim oZ As Object ' obj Zelle
Dim N As String ' Name
Dim W As String ' Wahrheitswert
Dim XaktTB1 As Long ' X aktuell Tabellen Blatt 1
Dim XaktTB2 As Long ' X aktuell Tabellen Blatt 2
Dim XmaxTB1 As Long ' X maximal Tabellen Blatt 1
Dim XmaxTB2 As Long ' X maximal Tabellen Blatt 2
Dim YaktTB1 As Long ' Y aktuell Tabellen Blatt 1
Dim YaktTB2 As Long ' Y aktuell Tabellen Blatt 2
Dim YmaxTB1 As Long ' Y maximal Tabellen Blatt 1
Dim YmaxTB2 As Long ' Y maximal Tabellen Blatt 2
Const WD = "x" ' Wahrheitswert Definition
oCD = ThisComponent ' initialisieren Object CALC Dokument
oTB1 = oCD.Sheets(0) ' initialisieren Tabellenblatt 1
oTB2 = oCD.Sheets(1) ' initialisieren Tabellenblatt 2
oCur = oTB1.createCursor ' TB1 Cursor
initialisieren
oCur.GotoEndOfUsedArea(False) ' TB1 genutzer Bereich
XmaxTB1 = oCur.getRangeAddress().endColumn ' TB1 letzte Spalte
YmaxTB1 = oCur.getRangeAddress().endRow ' TB1 letzte Zeile
For XaktTB1=1 To XmaxTB1 Step 1 ' TB1 über Spalten "B"
bis ...
oZ = oTB1.getCellByPosition(XaktTB1,0) ' TB1 Zelle
initialisieren
ReDim Preserve aGN(XaktTB1-1) ' Array-Element
initialisieren
aGN(XaktTB1-1) = oZ.STRING ' Zellinhalt in
Array-Element
Next XaktTB1
oCur = oTB2.createCursor
oCur.GotoEndOfUsedArea(False) ' TB2 Cursor
initialisieren
XmaxTB2 = oCur.getRangeAddress().endColumn ' TB2 genutzer Bereich
YmaxTB2 = oCur.getRangeAddress().endRow ' TB2 letzte Zeile
oTB2.clearContents(com.sun.star.sheet.CellFlags.STRING) ' TB2 alle
Inhalte löschen
oZ = oTB2.getCellByPosition(0,0) ' "A1"
initialisieren
oZ.STRING = "Name" ' "Name"
=> "A1
oZ = oTB2.getCellByPosition(1,0) ' "B1'
initialisieren
oZ.STRING = "Gruppe" ' "Gruppe"
=> "B2"
YaktTB2 = 0 ' TB2 Y
initialisieren
For YaktTB1=1 To YmaxTB1 Step 1 ' über TB1 Y
For XaktTB1=1 To XmaxTB1 Step 1 ' über TB1 X
oZ = oTB1.getCellByPosition(0,YaktTB1) ' TB1
'Name'-Zelle initialisieren
N = oZ.STRING ' 'Name' merken
oZ = oTB1.getCellByPosition(XaktTB1,YaktTB1) ' TB1
'Wahrheitswert'-Zelle initialisieren
W = oZ.STRING '
'Wahrheitswert' merken
If (W = WD) Then '
'Wahrheitswert' ist "x"
YaktTB2 = YaktTB2+1 ' TB2 nächste
Zeile initialisieren
oZ = oTB2.getCellByPosition(0,YaktTB2) ' TB2
'Name'-Zelle initialisieren
oZ.STRING = N ' 'Name' =>
Zelle
oZ = oTB2.getCellByPosition(1,YaktTB2) ' TB2
'Gruppe'-Zelle initialisieren
oZ.STRING = aGN(XaktTB1-1) ' TB2
Array-'Gruppe' > Zelle
EndIf
Next XaktTB1
Next YaktTB1
For iTB=0 To oCD.Sheets.count-1 ' über TBs
oCD.Sheets(iTB).getColumns().optimalWidth = True ' optimale
Spaltenbreite
oCD.Sheets(iTB).getRows().optimalHeight = True ' optimale
Zeilenhöhe
Next iTB
End Sub
------ Originalnachricht ------
Von: "Micha Kühn" <michaku...@habmalnefrage.de>
An: users@de.libreoffice.org
Gesendet: 18.08.2020 17:00:49
Betreff: [de-users] Calc-Frage
Hallo,
ich habe mal wieder eine Calc-Frage:
In einer Tabelle habe ich in Spalte A verschiedene Namen
In den Spalten B-...(z.B. B bis F) stehen Wahrheitswerte.
Diese sagen aus, ob derjenige, der in Spalte A steht, in Gruppe 1,
Gruppe 2, Gruppe 3 usw. Mitglied ist oder nicht.
Name Gruppe1 Gruppe2 Gruppe3 Gruppe4 ...
Name1 x
Name2 x x
Name3 x x
...
Jetzt benötige ich daraus ein weiteres Tabellenblatt, dass mir für jede
Mitgliedschaft eine einzelne Zeile generiert:
Name1 Gruppe1
Name2 Gruppe1
Name2 Gruppe3
Name3 Gruppe1
Name3 Gruppe2
...
Die Sortierung ist egal, es dürfte auch nach Gruppen sortiert sein.
Wie kriege ich das hin?
Danke für Tipps und liebe Grüße
Micha
--
Überlegen: Wer denken kann, ist klar im Vorteil.
(Der Postillon)
--
Liste abmelden mit E-Mail an: users+unsubscr...@de.libreoffice.org
Probleme?
https://de.libreoffice.org/hilfe-kontakt/mailing-listen/abmeldung-liste/
Tipps zu Listenmails: https://wiki.documentfoundation.org/Netiquette/de
Listenarchiv: https://listarchives.libreoffice.org/de/users/
Datenschutzerklärung: https://www.documentfoundation.org/privacy
Option Explicit
Sub Name_Gruppe
Dim aGN() As String ' arr Gruppen Name
Dim iTB As Integer ' idx Tabellen Blatt
Dim oCur As Object ' obj Cursor
Dim oCD As Object ' obj CALC Dokument
Dim oTB1 As Object ' obj Tabellen Blatt 1
Dim oTB2 As Object ' obj Tabellen Blatt 2
Dim oZ As Object ' obj Zelle
Dim N As String ' Name
Dim W As String ' Wahrheitswert
Dim XaktTB1 As Long ' X aktuell Tabellen Blatt 1
Dim XaktTB2 As Long ' X aktuell Tabellen Blatt 2
Dim XmaxTB1 As Long ' X maximal Tabellen Blatt 1
Dim XmaxTB2 As Long ' X maximal Tabellen Blatt 2
Dim YaktTB1 As Long ' Y aktuell Tabellen Blatt 1
Dim YaktTB2 As Long ' Y aktuell Tabellen Blatt 2
Dim YmaxTB1 As Long ' Y maximal Tabellen Blatt 1
Dim YmaxTB2 As Long ' Y maximal Tabellen Blatt 2
Const WD = "x" ' Wahrheitswert Definition
oCD = ThisComponent ' initialisieren Object CALC Dokument
oTB1 = oCD.Sheets(0) ' initialisieren Tabellenblatt 1
oTB2 = oCD.Sheets(1) ' initialisieren Tabellenblatt 2
oCur = oTB1.createCursor ' TB1 Cursor initialisieren
oCur.GotoEndOfUsedArea(False) ' TB1 genutzer Bereich
XmaxTB1 = oCur.getRangeAddress().endColumn ' TB1 letzte Spalte
YmaxTB1 = oCur.getRangeAddress().endRow ' TB1 letzte Zeile
For XaktTB1=1 To XmaxTB1 Step 1 ' TB1 über Spalten "B" bis ...
oZ = oTB1.getCellByPosition(XaktTB1,0) ' TB1 Zelle initialisieren
ReDim Preserve aGN(XaktTB1-1) ' Array-Element initialisieren
aGN(XaktTB1-1) = oZ.STRING ' Zellinhalt in Array-Element
Next XaktTB1
oCur = oTB2.createCursor
oCur.GotoEndOfUsedArea(False) ' TB2 Cursor initialisieren
XmaxTB2 = oCur.getRangeAddress().endColumn ' TB2 genutzer Bereich
YmaxTB2 = oCur.getRangeAddress().endRow ' TB2 letzte Zeile
oTB2.clearContents(com.sun.star.sheet.CellFlags.STRING) ' TB2 alle Inhalte
löschen
oZ = oTB2.getCellByPosition(0,0) ' "A1"
initialisieren
oZ.STRING = "Name" ' "Name" => "A1
oZ = oTB2.getCellByPosition(1,0) ' "B1'
initialisieren
oZ.STRING = "Gruppe" ' "Gruppe" => "B2"
YaktTB2 = 0 ' TB2 Y initialisieren
For YaktTB1=1 To YmaxTB1 Step 1 ' über TB1 Y
For XaktTB1=1 To XmaxTB1 Step 1 ' über TB1 X
oZ = oTB1.getCellByPosition(0,YaktTB1) ' TB1 'Name'-Zelle
initialisieren
N = oZ.STRING ' 'Name' merken
oZ = oTB1.getCellByPosition(XaktTB1,YaktTB1) ' TB1
'Wahrheitswert'-Zelle initialisieren
W = oZ.STRING ' 'Wahrheitswert' merken
If (W = WD) Then ' 'Wahrheitswert' ist
"x"
YaktTB2 = YaktTB2+1 ' TB2 nächste Zeile
initialisieren
oZ = oTB2.getCellByPosition(0,YaktTB2) ' TB2 'Name'-Zelle
initialisieren
oZ.STRING = N ' 'Name' => Zelle
oZ = oTB2.getCellByPosition(1,YaktTB2) ' TB2 'Gruppe'-Zelle
initialisieren
oZ.STRING = aGN(XaktTB1-1) ' TB2 Array-'Gruppe' >
Zelle
EndIf
Next XaktTB1
Next YaktTB1
For iTB=0 To oCD.Sheets.count-1 ' über TBs
oCD.Sheets(iTB).getColumns().optimalWidth = True ' optimale
Spaltenbreite
oCD.Sheets(iTB).getRows().optimalHeight = True ' optimale Zeilenhöhe
Next iTB
End Sub
--
Liste abmelden mit E-Mail an: users+unsubscr...@de.libreoffice.org
Probleme?
https://de.libreoffice.org/hilfe-kontakt/mailing-listen/abmeldung-liste/
Tipps zu Listenmails: https://wiki.documentfoundation.org/Netiquette/de
Listenarchiv: https://listarchives.libreoffice.org/de/users/
Datenschutzerklärung: https://www.documentfoundation.org/privacy
