Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
24.04.2024 17:19:09
Formel mit Index-Funktion
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1464to1468
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1464to1468
1464to1468
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Umfrageauswertung Zellen umpositionieren

Umfrageauswertung Zellen umpositionieren
08.01.2016 17:07:47
Max
Hallo zusammen!
Ich stehe vor einer kleinen Schwierigkeit: https://www.herber.de/bbs/user/102678.xlsx
Via VBA habe ich mir bereits die Ergebnisse einer Umfrage aus Word nach Excel gezogen.
Jetzt ist die Situation wie folgt (siehe Datei im Anhang):
Zu jeder Fragenummer (z.B. q008) gehören mehrere Unter-IDs (z.B. q008_1 bis q008_5).
Ich möchte, dass das angekreuzte Ergebnis immer an Position _1 steht. Versucht habe ich bereits eine VerkettenWenn-Funktion, die ich mir in VBA zusammenprogrammiert habe, da die Datei aber bis zu 1000 Zeilen haben soll, wird Excel dann ein wenig langsam.
Könnt ihr mir da helfen?
Ich danke euch!!
Viele Grüße
Max

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Umfrageauswertung Zellen umpositionieren
09.01.2016 14:15:08
fcs
Hallo Max,
hier ein Makro zum Umgruppieren der Daten.
Gruß
Franz 
Sub Daten_Umgruppieren()
Dim wks As Worksheet
Dim Zeile_1 As Long, Zeile As Long, Zeile_L As Long
Dim strErgebnis As String
Dim varZugeh As Variant
Dim StatusCalc As Long
Set wks = ActiveSheet
varZugeh = ""
'Makrobremsen lösen
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
With wks
Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row
'Zeilennummer 2 in den Cells-Eigenschaften ggf. anpassen
.Range(.Cells(2, 5), .Cells(Zeile_L, 5)).ClearContents
.Cells(2, 5).Value = "Itemlösung"
'Startzeilennummer ggf. anpassen
For Zeile = 3 To Zeile_L + 1
If varZugeh  .Cells(Zeile, 1).Text Then
If Zeile_1 > 0 Then
'Ergebnis in Spalte E eintragen
.Cells(Zeile_1, 5).Value = strErgebnis
End If
strErgebnis = ""
Zeile_1 = Zeile
varZugeh = .Cells(Zeile, 1)
End If
With .Cells(Zeile, 4)
If .Value  "" Then
strErgebnis = strErgebnis & IIf(strErgebnis  "", ", ", "") & .Text
End If
End With
Next Zeile
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub

Anzeige
AW: Umfrageauswertung Zellen umpositionieren
11.01.2016 09:43:23
Max
Hi Franz,
zuerst mal Danke für die super Hilfe, es funktioniert fast perfekt! Allerdings wird der erste Wert eine Spalte zu tief eingetragen, wenn ich versuche, das zu ändern, rutschen die anderen Werte auch eine Spalte hoch. Könntest Du mir den Gefallen tun, da noch mal draufzuschauen?
Vielen Dank und viele Grüße!
Max

AW: Umfrageauswertung Zellen umpositionieren
11.01.2016 10:58:57
fcs
Hallo Max,
also das Makro setzt die Daten genau so um wie in deiner Beispiel-Tabelle dargestellt.
Hier das Makro angepasst, wenn die Spaltentitel in Zeile 1 und die Daten ab Zeile 2 stehen.
Hinweis:
In Excel sind Spalten die die Elemente von links nach rechts in einem Tabellenblatt.
Zeilen sind die Elemente von oben nach unten.
Gruß
Franz 
Sub Daten_Umgruppieren()
Dim wks As Worksheet
Dim Zeile_1 As Long, Zeile As Long, Zeile_L As Long
Dim strErgebnis As String
Dim varZugeh As Variant
Dim StatusCalc As Long
Set wks = ActiveSheet
Const ZeiSpaltentitel As Long = 1 'Zeile mit den Spaltentiteln - ggf. anpassen
varZugeh = ""
'Makrobremsen lösen
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
With wks
Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(ZeiSpaltentitel, 5), .Cells(Zeile_L, 5)).ClearContents
.Cells(ZeiSpaltentitel, 5).Value = "Itemlösung"
For Zeile = ZeiSpaltentitel + 1 To Zeile_L + 1
If varZugeh  .Cells(Zeile, 1).Text Then
If Zeile_1 > 0 Then
'Ergebnis in Spalte E eintragen
.Cells(Zeile_1, 5).Value = strErgebnis
End If
strErgebnis = ""
Zeile_1 = Zeile
varZugeh = .Cells(Zeile, 1)
End If
With .Cells(Zeile, 4)
If .Value  "" Then
strErgebnis = strErgebnis & IIf(strErgebnis  "", ", ", "") & .Text
End If
End With
Next Zeile
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige