Thema Datum  Von Nutzer Rating
Antwort
Rot Zufallsgenerator Fehlersuche
16.02.2020 14:53:49 LostSunday
NotSolved
16.02.2020 18:21:40 Gast25798
NotSolved
16.02.2020 18:38:21 Gast8468
****
NotSolved
17.02.2020 08:22:25 Gast34345
NotSolved
16.02.2020 19:58:33 Gast0815
***
NotSolved

Ansicht des Beitrags:
Von:
LostSunday
Datum:
16.02.2020 14:53:49
Views:
801
Rating: Antwort:
  Ja
Thema:
Zufallsgenerator Fehlersuche

Hallo liebe Community,

Ich bin noch ein ziemlicher Anfänger mit der Verwendung von VBA und stehe gerade ein wenig an.

Mein Zeil war, dass das Makro mir auf einem seperaten Sheet eine zufällige Auswahl an Namen ausspuckt. Diese Auswahl soll je nach eingegebener Menge zu gleichen Teilen aus drei verschiedenen Gruppen Stammen. Heißt will man einen zufälligen output an 15 Namen so sollen 5 davon zufällig aus gruppe 1 stammen, 5 davon zufällig aus gruppe 2 und 5 davon zufällig aus gruppe 3.

Jetzt funktioniert das aber nicht wirklich, bzw habe ich immer wieder Fehlermeldungen. Könnte mir vielleicht bitte jemand helfen das Script richtig zu stelle?.

Damit wäre mir sehr geholfen. Sitze schon den ganzen Sonntag daran.

Vielen lieben Dank


Aktuelles Script:

Sub HashtagcloudGenerator()

Dim HowMany As Integer
Dim NoOfHashtags As Long
Dim NoOfHashtags1 As Long
Dim NoOfHashtags2 As Long
Dim NoOfHashtags3 As Long
Dim RandomNumber As Integer
Dim RandomNumber1 As Integer
Dim RandomNumber2 As Integer
Dim RandomNumber3 As Integer
Dim Hashtags() As String
Dim Group1() As String 'Array to store randomly selected names
Dim Group2() As String
Dim Group3() As String
Dim i As Byte
Dim CellsOut As Long 'Variable to be used when entering names onto worksheet
Dim ArI As Byte 'Variable to increment through array indexes

Application.ScreenUpdating = False

HowMany = ThisWorkbook.Worksheets("Hashtagcloud Generator").Range("B3").Value
CellsOut = ThisWorkbook.Worksheets("Hashtagcloud Generator") = 5

ReDim Hashtags(1 To Group1 + Group2 + Group3) 'Set the array size to how many names required
ReDim Group1(1 To HowMany / 3)
ReDim Group2(1 To HowMany / 3)
ReDim Group3(1 To HowMany / 3)
NoOfHashtags1 = ThisWorkbook.Worksheets("Hashtaggroups").Application.CountA(Range("A:A")) - 1 ' Find how many names in the list
NoOfHashtags2 = ThisWorkbook.Worksheets("Hashtaggroups").Application.CountA(Range("B:B")) - 1
NoOfHashtags3 = ThisWorkbook.Worksheets("Hashtaggroups").Application.CountA(Range("C:C")) - 1
NoOfHashtags = NoOfHashtags1 + NoOfHashtags2 + NoOfHashtags3
i = 1

Do While i <= HowMany
RandomNo1:
    RandomNumber1 = Application.RandBetween(2, NoOfHashtags1 + 1)
    'Check to see if the name has already been picked
    For ArI = LBound(Group1) To UBound(Group1)
        If Group1(ArI) = Cells(RandomNumber1, 1).Value Then
            GoTo RandomNo1
        End If
    Next ArI
    Group1(i) = Cells(RandomNumber1, 1).Value ' Assign random name to the array
    i = i + 1
RandomNo2:
 RandomNumber2 = Application.RandBetween(2, NoOfHashtags2 + 1)
    'Check to see if the name has already been picked
    For ArI = LBound(Group2) To UBound(Group2)
        If Group2(ArI) = Cells(RandomNumber2, 1).Value Then
            GoTo RandomNo2
        End If
    Next ArI
    Group2(i) = Cells(RandomNumber2, 1).Value ' Assign random name to the array
    i = i + 1
RandomNo3:
 RandomNumber3 = Application.RandBetween(2, NoOfHashtags3 + 1)
    'Check to see if the name has already been picked
    For ArI = LBound(Group3) To UBound(Group3)
        If Group3(ArI) = Cells(RandomNumber3, 1).Value Then
            GoTo RandomNo3
        End If
    Next ArI
    Group3(i) = Cells(RandomNumber3, 1).Value ' Assign random name to the array
    i = i + 1
Loop

'Loop through the array and enter names onto the worksheet
For ArI = LBound(Hashtags) To UBound(Hashtags)

    Cells(CellsOut, 2) = Hashtags(ArI)
    CellsOut = CellsOut + 1

Next ArI

Application.ScreenUpdating = True

End Sub


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Zufallsgenerator Fehlersuche
16.02.2020 14:53:49 LostSunday
NotSolved
16.02.2020 18:21:40 Gast25798
NotSolved
16.02.2020 18:38:21 Gast8468
****
NotSolved
17.02.2020 08:22:25 Gast34345
NotSolved
16.02.2020 19:58:33 Gast0815
***
NotSolved