Verzwicktes Problem - Zellen zufällig verknüpfen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

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

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

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

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)

Beliebteste Forumthreads (12 Monate)

Verzwicktes Problem - Zellen zufällig verknüpfen

23 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread