Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1112to1116
1112to1116
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Verzwicktes Problem - Zellen zufällig verknüpfen

Forumthread: Verzwicktes Problem - Zellen zufällig verknüpfen

Verzwicktes Problem - Zellen zufällig verknüpfen
Stefan
Hallo,
ein für mich leider unlösbare Aufgabe stellt sich mir. Ich habe eine Excel Datei mit Artikeln in Tabelle 1. Jede Zeile ist ein anderer Artikel. Zu diesen Artikel will ich relativ sinnvoll Schlagwörter in eine Zelle hinzufügen. Die Schlagwörter liegen mir in der dritten Tabelle mit Namen "Keywords" vor. Jede Spalte ist eine ander Kategorie an Schlagwörtern. Und jede Zelle ist mit einem Schlagwort befüllt.
Gibt es eine Möglichkeit aus diesen Spalten zufällig immer 30 Schlagwörter auszuwählen und in einer Zelle zusammenzufügen, also zu verketten? Und zwar so, dass ich in Tabelle 1 schon definiere, aus welcher Spalte in Tabelle 3 die Keywords gezogen werden sollen.
Uiuiui, geht das überhaupt?
LG und Danke
Stefan
Anzeige
Zufallsauswahl verketten
28.10.2009 23:25:13
Erich
Hi Stefan,
das Makro "Schlagw" tut wohl so etwas.
(Das entspricht wohl kaum deinem Tabellenaufbau - den hast du uns ja nicht verraten.) 

Option Explicit
Sub Schlagw()
' www.herber.de/forum/archiv/1112to1116/t1112904.htm - Erich G. 28.10.2009
Dim wks3 As Worksheet, lngZ As Long, zz As Long, lngN As Long, arrE() As String
Dim arrK, arrZ
Const SpKat As Long = 2  ' Spalte, in der die Nr. der Spalte in Tab3 anegegben wird
Const SpSch As Long = 4  ' Spalte, in der die Schlagwörter abgelegt werden
Set wks3 = Worksheets("Tabelle3")
With Worksheets("Tabelle1")
lngZ = .Cells(.Rows.Count, SpKat).End(xlUp).Row
arrK = Application.Transpose(.Cells(SpKat, 2).Resize(lngZ - 1))
ReDim arrE(2 To lngZ)
For zz = 2 To lngZ
lngN = wks3.Cells(wks3.Rows.Count, arrK(zz - 1)).End(xlUp).Row
arrZ = Zufallsliste(lngN)
arrE(zz) = wks3.Cells(arrZ(1), arrK(zz - 1))
For lngN = 2 To 30
arrE(zz) = arrE(zz) & " " & wks3.Cells(arrZ(lngN), arrK(zz - 1))
Next lngN
Next zz
.Cells(2, SpSch).Resize(lngZ - 1) = Application.Transpose(arrE)
End With
End Sub
Function Zufallsliste(lngX As Long)
' Zahlen 1 bis Anzahl ohne Wiederholungen - ingUR 04.12.2006
' www.herber.de/forum/archiv/824to828/t825988.htm
Dim ii As Long, iLosNr As Long, arrOK() As Boolean, arrLos() As Long
ReDim arrOK(1 To lngX), arrLos(1 To lngX)
Randomize
For ii = 1 To lngX
Do
iLosNr = Int((lngX * Rnd) + 1)
If Not arrOK(iLosNr) Then arrLos(ii) = iLosNr: arrOK(iLosNr) = True
Loop Until arrLos(ii) > 0
Next
Zufallsliste = arrLos
End Function
Und hier eine Beispielmappe: https://www.herber.de/bbs/user/65414.xls
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Zufallsauswahl verketten
29.10.2009 15:10:22
Stefan
Hi,
also ih bastle jetzt schon ne ganze Weile dran rum und bekomme es leider nicht hin. Meinst Du Du könntest auf Basis der hinterlegten Datei einige EInstellungen im Code vornehmen? Ich meine nämlich, dass dieser Grundsätzlich dafür geeignet sein sollte.
https://www.herber.de/bbs/user/65436.zip
Daaaanke
Anzeige
AW: Zufallsauswahl verketten
29.10.2009 17:27:28
Stefan
Vielleicht bekomme ich es doch hin... melde mich.
In jedem Fall ist es genau das, was ich suche.
Daaaanke!
AW: Zufallsauswahl verketten
29.10.2009 17:35:17
Stefan
Saumäßig, wirklich.
Nun hab ich nur noch ein Problem. Je Artikel sollen maximal 10 Suchworte eingepflegt werden. Teilweise sind viel mehr drin.
teilweise fehlen aber auch Keywords, wohl weil die Spalten der KEywords nicht immer mit gleich vielen Keywords befüllt sind.
Kann man das DIng so umschreiben, dass die Suchworte immer komplett bis zum Ende der entsprechenden Spalte ausgenutzt werden? Also wenn 400 STK in Spalte 1 und 20 in Spalte 2 drin stehen, dass dann wirklich auch alle bei Spalte 1 400 im Auswahltopf sind und bei Spalte 2 nur die vorhandenen 20.
Die Liste wird auch immer weiter ausgebaut.
Daaanke nochmals an dieser Stelle!
Anzeige
Rückfragen
29.10.2009 20:17:45
Erich
Hi Stefan,
"Saumäßig, wirklich." Was meinst du denn mit dieser Einleitung? :-)
Da habe ich jetzt noch ein paar Fragen - bezogen auf die Chefkochdatei-demo.xls aus 65436.zip,
also die letzte Mappe, die du hochgeladen hast.
1. Bedeuten die Wörter "Kategorie" und "Suchwort" hier dasselbe?
Bedeuten die Wörter "Keyword" und "Schlagwort" hier dasselbe?
Ich benutze jetzt mal nur "Kategorie". Darunter stehen dann die Schlagwörter der Kategorie.
2.
Fangen die Kategorien in Zeile 1 immer in Spalte U an? Stehen rechts davon nur noch Kategorien?
(im Beispiel bis Spalte AL)
3.
"Nun hab ich nur noch ein Problem. Je Artikel sollen maximal 10 Suchworte eingepflegt werden.
Teilweise sind viel mehr drin."
Im Beispiel stehen da 18 Kategorien. Dem Makro sollte das egal sein - es verarbeitet alle 18, nicht nur 10.
4.
"Kann man das DIng so umschreiben, dass die Suchworte immer komplett
bis zum Ende der entsprechenden Spalte ausgenutzt werden?"
Mein Makro war so geschrieben. In der Zeile
lngN = wks3.Cells(wks3.Rows.Count, arrK(zz - 1)).End(xlUp).Row
wird für jede Kategorie einzeln die Anzahl Zeilen ermittelt,
mit dieser Anzahl dann eine Zufallsliste erstellt: arrZ = Zufallsliste(lngN)
5.
"Die Liste wird auch immer weiter ausgebaut."
Was willst du uns damit sagen?
Was meinst du mit "Die Liste", die in Blatt "Chefkochdatei" oder die in Blatt "keywords"?
6.
In Blatt "keywords" gibt es störende öleere Zellen, z. B. A2 oder E7. Muss das so sein?
Wenn ja, müsste man da etwas mehr programmieren.
7.
In Blatt "keywords" gibt es zu allen Kategorien weniger als 30 Schlagwörter,
z. B. in Spalte D (Fisch) nur 5 Schlagwörter.
Was soll geschehen, wenn es weniger als 30 Schlagwörter zu einer Kategorie gibt?
8.
Aus deinem Beitrag geht hervor, dass du an dem Makro weitergearbeitet hast.
Warum hast du es nicht gleich gepostet? Dann wären wir auf dem gleichen Stand.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Rückfragen
30.10.2009 09:02:07
Stefan
Saumäßig ist ein Ausdruck eines Gefühls der Begeisterung.... bin so n halber Schwabe... :) .
Ich kann eigentlich ganz gut mit der Beispielmappe arbeiten. Ich glaube der Fehler ist, dass in den Kategorien ab und an leere Zellen stehen und der Code das dann als ENde der Spalte wertet. Ich prüfe das mal und melde mich wieder!!!
LG und Danke für Deine Mühen, echt genial!
Anzeige
AW: Rückfragen
30.10.2009 13:06:27
Stefan
Hi,
das script mit Beispielmappe passt wie die Faust aufs Auge!
Mein Problem war, dass die Keywordlisten seltsamerweise leere Felder unterhalb des letzten Wortes hatten, die der Code aber als befüllt gesehen hatte. Ich bin einfach über diese Felder mit dem ENTF. Befehl drüber und gut war.
Daaaaanke!
Anzeige
AW: Rückfragen
30.10.2009 15:35:57
Stefan
Hallo Erich,
sag mal, wäre es denkbar, in der Spalte, wo ich die Kategorie definiere, aus der die Schlagwörter gezogen werden sollen, zwei Zahlen anzugeben und ein Mix aus verschiedenen Spaleten generiert wird?
Daaanke und liebe Grüße
Stefan
Antwort: Ja, es IST, "wäre" nicht nur...
30.10.2009 20:16:08
Erich
Hi Stefan,
nach meiner tollen ;-)) Antwort im Betreff hier der Code
(Die Fkt. Zufallsliste wird weiterhin gebraucht.): 

Option Explicit
Sub Schlagw2()
' www.herber.de/forum/archiv/1112to1116/t1112904.htm
' Erich G. - 28.10.2009
Dim wks3 As Worksheet, lngZ As Long, zz As Long, lngN As Long, arrE() As String
Dim arrK, arrZ, pp As Long, strT As String
Dim lngK1 As Long, lngK2 As Long, lngN1 As Long, lngN2 As Long
Const SpKat As Long = 2  ' Spalte, in der max. 2 Tab3-Spalten-Nr. angegeben werden
'    Trennzeichen ist "+", z. B. 4+1 für Spalten 4 und 1
Const SpSch As Long = 4  ' Spalte, in der die Schlagwörter abgelegt werden
Set wks3 = Worksheets("Tabelle3")
With Worksheets("Tabelle1")
lngZ = .Cells(.Rows.Count, SpKat).End(xlUp).Row
arrK = Application.Transpose(.Cells(SpKat, 2).Resize(lngZ - 1))
ReDim arrE(2 To lngZ)
For zz = 2 To lngZ
strT = arrK(zz - 1)
pp = InStr(strT, "+")
Select Case pp
Case 0, 1:      lngK1 = Mid(strT, pp + 1):  lngK2 = 0:  lngN2 = 0
Case Len(strT): lngK1 = Left(strT, pp - 1): lngK2 = 0:  lngN2 = 0
Case Else
lngK1 = Left(strT, pp - 1): lngK2 = Mid(strT, pp + 1)
lngN2 = wks3.Cells(wks3.Rows.Count, lngK2).End(xlUp).Row
End Select
lngN1 = wks3.Cells(wks3.Rows.Count, lngK1).End(xlUp).Row
arrZ = Zufallsliste(lngN1 + lngN2)
For lngN = 1 To 30
If lngN > 1 Then arrE(zz) = arrE(zz) & " "
arrE(zz) = arrE(zz) & wks3.Cells(arrZ(lngN) + lngN1 * (arrZ(lngN) > lngN1), _
-lngK1 * (arrZ(lngN)  lngN1))
Next lngN
Next zz
.Cells(2, SpSch).Resize(lngZ - 1) = Application.Transpose(arrE)
End With
End Sub
In der Spalte mit den Kat-Nr. kannst du z. B. schreiben: 1 oder +3 oder 4+ oder 3+5 oder 2+2 oder...
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
kleine Vereinfachung
30.10.2009 20:30:03
Erich
Hi Stefan,
in der Prozedur könntest du noch die untere der beiden Zeilen 

arrE(zz) = arrE(zz) & wks3.Cells(arrZ(lngN) + lngN1 * (arrZ(lngN) > lngN1), _
-lngK1 * (arrZ(lngN)  lngN1))

ersetzen durch 

arrE(zz) = arrE(zz) & wks3.Cells(arrZ(lngN) + lngN1 * (arrZ(lngN) > lngN1), _
IIf(arrZ(lngN)
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: kleine Vereinfachung
30.10.2009 21:11:54
Stefan
GEIL!!! DANKE!
AW: kleine Vereinfachung
30.10.2009 23:33:42
Stefan
Hi Erich,
ich kann keine Kat anwählen, die höher als 8 ist. Wo ändere ich denn das so, dass ich auch höhere Werte angeben kann?
Daanke
Yes I can!
31.10.2009 00:28:54
Erich
Hi Stefan,
"ich kann keine Kat anwählen, die höher als 8 ist"?
Wer oder was verhindert denn, dass du das einfach tust?
Du hast da doch wohl keine Gültigkeitsprüfung eingebaut?
Falls du nun doch eine Kategoriespalte > 8 vorgeben kannst: Was passiert? Fehlermeldung?
In dieser Mappe jedenfalls bereitet das keine Probleme: https://www.herber.de/bbs/user/65477.xls
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Yes I can!
31.10.2009 07:50:18
Stefan
Hmm, ja geht bei mir auch... ich Suche noch.
Keine Ahnung.
Ich mach hier schon seit Stunden rum...
Ich bekomme bei meinen Daten immer einen Laufzeitfehler.
Ich bekomm das aber hin.
Grüße und Danke
Stefan
AW: Yes I can!
31.10.2009 08:30:41
Stefan
Hi,
also es ist definitiv ein Eingabefehler meinerseits...
Sag mal, ohne unverschämt sein zu wollen - gibt es auch eine Möglichkeit, beliebig viele Kats zu verknüpfen?
LG und ein schönes WE
Stefan
Anzeige
Es geht - mit (fast) beliebig vielen Kategorien
31.10.2009 18:49:51
Erich
Hi Stefan,
probier mal: 

Option Explicit
Sub SchlagwN()                   ' www.herber.de/forum/archiv/1112to1116/t1112904.htm
' Erich G. - 31.10.2009
Dim wks3 As Worksheet, lngZ As Long, zz As Long, lngN As Long, arrE() As String
Dim arrK, arrZ, pp As Long, strT As String
Dim aStrK, alngN() As Long, alngS() As Long, lngA As Long, aLngK() As Long
Const SpKat As Long = 2  ' Spalte, in der etliche Tab3-Spalten-Nr. angegeben werden
'    Trennzeichen ist "+", z. B. 4+11+5 für Spalten 4, 11, 5
Const SpSch As Long = 4  ' Spalte, in der die Schlagwörter abgelegt werden
Set wks3 = Worksheets("Tabelle3")
With Worksheets("Tabelle1")
lngZ = .Cells(.Rows.Count, SpKat).End(xlUp).Row
arrK = Application.Transpose(.Cells(SpKat, 2).Resize(lngZ - 1))
ReDim arrE(2 To lngZ)
For zz = 2 To lngZ
aStrK = Split(arrK(zz - 1), "+")
lngA = UBound(aStrK)
ReDim aLngK(0 To lngA), alngN(0 To lngA), alngS(0 To lngA)
For pp = 0 To lngA
aLngK(pp) = CLng(aStrK(pp))
alngN(pp) = wks3.Cells(wks3.Rows.Count, aLngK(pp)).End(xlUp).Row
If pp > 0 Then alngS(pp) = alngS(pp - 1) + alngN(pp - 1)
Next pp
arrZ = Zufallsliste(Application.Max(alngS(lngA) + alngN(0)))
For lngN = 1 To 30
If lngN > 1 Then arrE(zz) = arrE(zz) & " "
For pp = 0 To lngA - 1
If arrZ(lngN)
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Es geht - mit (fast) beliebig vielen Kategorien
02.11.2009 12:10:21
Stefan
Hi Erich,
ich habe ein kleines Problem mit der Funktion. Ich habe meine Zeilen geprüft und irgendwo hat sich ein Fehler eingeschlichen, ich kann diesen leide rnicht finden. Für mich sieht alles normal aus.
Ich bekomme immer einen Laufzeitfehler 9 und diese Zeile wird markiert:
arrE(zz) = arrE(zz) & wks3.Cells(arrZ(lngN) - alngS(pp), aLngK(pp))
Idee`?
Danke und liebe Grüße
Stefan
Anzeige
Der Fehler ist so kaum zu finden
02.11.2009 13:41:01
Erich
Hi Stefan,
ohne Beispielmappe (mit darin auftretendem Fehler) fällt eine Antwort schwer.
Was hast du am Code geändert?
Gibt es Konstellationen, wo es läuft?
Liegt es irgendwie an den Daten?
Error 9 ist ein Überlauf (Index zu klein oder zu groß).
Ist zz zu groß? oder lngH? oder pp?
Ist arrE() zu klein deklariert? oder aLngS()? oder aLngK()?
Der Fehler entsteht wohl VOR der von dir geposteten Zeile.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Der Fehler ist so kaum zu finden
02.11.2009 13:55:40
Stefan
Ich habe den Fehler gefunden. Er tritt auf, wenn die Anzahl der Keywords sehr klein, vermutlich unter der Anzahl der angeforderten Zahl für das Ergebnis liegt.
Grüße
noch ein Fehler
02.11.2009 14:50:08
Erich
Hi Stefan,
auch ich habe bei dieser Gelegenheit noch einen Fehler gefunden. Die Zeile
arrZ = Zufallsliste(Application.Max(alngS(lngA) + alngN(0)))
ist in mehrfacher Hinsicht Unfug:
Das Max wird nur über eine Zahl gebildet - und es ist auch noch die falsche Zahl...
Bitte tausche die Zeile aus gegen
arrZ = Zufallsliste(alngS(lngA) + alngN(lngA))
Möglich wäre auch: arrZ = Zufallsliste(Application.Sum(alngN))
Rückmeldung wäre nett! - Sorry und Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: noch ein Fehler
02.11.2009 15:02:10
Stefan
unentschuldbar... undentschuldbar... DAAAAAANKE!!!!
AW: Der Fehler ist so kaum zu finden
02.11.2009 14:14:05
Stefan
Das musst Du übrigens nicht ändern - ich kopiere einfach die KEywords nach unten und es passt.
Daaanke vielmals für die freundliche Hilfe und liebe Grüße aus Acshaffenburg
AW: Verzwicktes Problem - Zellen zufällig verknüpfen
29.10.2009 10:52:09
Stefan
Hi,
anhängend mal eine Demo Datei. Das könnte so funktionieren.
https://www.herber.de/bbs/user/65422.zip
Daaaanke und liebe Grüße
Stefan
Anzeige
;

Beliebteste Forumthreads (12 Monate)

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