Date: prev next · Thread: first prev next last
2020 Archives by date, by thread · List index 

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: michakuehn@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" <michakuehn@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+unsubscribe@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+unsubscribe@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

Context

Privacy Policy | Impressum (Legal Info) | Copyright information: Unless otherwise specified, all text and images on this website are licensed under the Creative Commons Attribution-Share Alike 3.0 License. This does not include the source code of LibreOffice, which is licensed under the Mozilla Public License (MPLv2). "LibreOffice" and "The Document Foundation" are registered trademarks of their corresponding registered owners or are in actual use as trademarks in one or more countries. Their respective logos and icons are also subject to international copyright laws. Use thereof is explained in our trademark policy.