Input-Output

[janvdallas]

Ik heb 2 kolommen met input waarden en hieruit moeten 4 kolommen worden gegenereerd zoals in voorbeeld Input_output.xlsx . Kolom A moet de waarde van kolom G krijgen gevolgd door een volgnummer. het volgnummer is het aantal rijen in kolom F. Ik denk overigens dat de bijlage het duidelijker maakt dan de manier waarop ik het hier probeer te omschrijven
e

 

[Timshel]

Het onderwerp "input-output" is te algemeen geformuleerd. Gebruikers met een gelijksoortige vraag als jij kunnen dit draadje nooit vinden zo, gesteld dat het opgelost wordt.
Is het de bedoeling om alle combinaties van waarden uit kolom F en kolom G uit te werken?

 

[Cobbe]

Met een macro'tje:

Sub cobbe()
Range("A3:A100").ClearContents
co1 = WorksheetFunction.CountA(Range("F3:F11"))
For Each c In Range("G3:G" & Range("G" & Rows.Count).End(xlUp).Row)
 For i = 1 To co1
  co2 = Range("A" & Rows.Count).End(xlUp).Row + 1
   Cells(co2, 1) = c.Value & "-" & i
 Next
Next
End Sub

 

[VenA]

Ik lees de vraag hetzelfde als Timshel dan wordt de code bv zo.

Sub VenA()
Dim j As Long, jj As Long, t As Long, ar, ar1
  ar = Sheets(1).Cells(1).CurrentRegion
  ReDim ar1((UBound(ar) - 1) ^ 2, 4)
    For j = 2 To UBound(ar)
      For jj = 2 To UBound(ar)
        ar1(t, 0) = ar(j, 2) & "-" & jj - 1
        ar1(t, 1) = ar(j, 1)
        ar1(t, 2) = ar(j, 2)
        ar1(t, 3) = Date + 1
        ar1(t, 4) = Date
        t = t + 1
      Next jj
    Next j
    Sheets(1).Cells(2, 10).Resize(UBound(ar1) + 1, UBound(ar1, 2) + 1) = ar1
End Sub

 

[HSV]

Ik lees het anders (ook maar 4 kolommen ipv 5 zoals in het voorbeeld-bestand staat.

Sub hsv()
Dim sn, i As Long, ii As Long, n As Long
  sn = Sheets(1).Range("F3:G" & Cells(Rows.Count, 6).End(xlUp).Row)
  ReDim arr(4, 0)
    For i = 1 To UBound(sn)
      For ii = 1 To UBound(sn)
        arr(0, n) = sn(i, 2) & "-" & ii
        arr(1, n) = sn(ii, 1)
        arr(2, n) = sn(i, 2)
        arr(3, n) = clng(Date + 1)
        'arr(4, n) = clng(Date)
        n = n + 1
       ReDim Preserve arr(4, UBound(sn, 2) + n)
      Next ii
    Next i
    Sheets(1).Cells(2, 16).Resize(UBound(arr, 2), UBound(arr)) = Application.Transpose(arr)
End Sub

Ps; dan mag je er nog 2 aftrekken als je zin hebt.

Sheets(1).Cells(2, 16).Resize(UBound(arr, 2)-2, UBound(arr)) = Application.Transpose(arr)

 

[janvdallas]

Nee niet alle combi's alleen zoals in het voorbeeld bestand

 

[janvdallas]

Dank voor jullie snelle reacties. Ik kan hiermee voouit.

 

[janvdallas]

Toch nog niet helemaal goed en kom er zelf niet uit. De output in kolom K is niet goed. Deze moet zijn prot 1,prot2,prot3 en dan weer prot1,prot2,prot3 en dan weer prot1,prot2,prot3 en dus niet prot1,prot1,prot 1 en dan prot2,prot2,prot2. De input in kolom A en B kan overigens langer dan 3 rijen zijn en aantal rijen hoeft ook niet hetzelfde te zijn. (meestal is kolom B langer)

 

[Cobbe]

Dus toch zoals in post #3

 

[janvdallas]

Cobbe, dank voor je snelle reactie maar is nog niet goed. Oplossing van VenA was goed op kolom E na (de waarden met de protocollen, deze moeten steeds een herhaling zijn van prot1, prot2,prot 3 t/m protx

 

[VenA]

Het quoten is niet nodig.

Dan deugt het voorbeeld niet daarin staat pro1, pro2, pro3. Je kan toch zien hoe de codes een volgnummer krijgen. Dan lijkt het mij niet zo moeilijk om dat ook voor de protocollen voor elkaar te krijgen.

 

[janvdallas]

In het voorbeeld staat het goed. In de input zit al een nummer maar is geen volgnummer. Volgnummer moet alleen in 1e kolom terecht komen. protocollen moeten x aantal keer worden herhaald, prot1-3 en dan weer prot1-3 enz

 

[VenA]

Druk svp op de knop 'Reageer op bericht' of op 'Snel reageren.' We begrijpen zelf wel wat er geschreven is.

De oplossing is in de code van HSV te vinden.

ar1(t, 1) = ar(jj, 1)

 

[janvdallas]

Ik ga hiermee aan de slag. Dank

 

[huijb]

@janvdallas Graag stoppen met onnodige quoten. Onnodig quoten wil zeggen als je direct reageert op een antwoord en dat antwoord ook quote. Niet doen a.u.b.

 

[janvdallas]

@Allen: excuses voor het onnodig quoten.
@VenA dat werkt inderdaad, kolom K gaat nu goed. Kun je me nog helpen met 1 vraag? Indien ik in de Input kolom B een extra waarde bbb4 ingeef moet kolom J uit net zoveel keer bbb1, bbb2 , bbb3 en bbb4 bestaan als het aantal codes in input kolom A en niet aantal zoals in kolom B. Zie bijlage.

 

[Timshel]

Toch het uitwerken van alle combi's, zoals ik al zei in #2.
Met een heldere uitleg zijn er max 5 posts nodig om dit toch niet al te ingewikkelde vraagstuk op te lossen.

Sub tsh()
    Dim i As Long, j As Long, k As Long
    Dim x As Long, y As Long
    Dim Br, Bq
    
    Br = Sheets(1).Cells(1).CurrentRegion
    x = Application.CountA(Sheets(1).Columns(1))
    y = Application.CountA(Sheets(1).Columns(2))
    ReDim Bq((x - 1) * (y - 1) - 1, 4)
    For i = 2 To y
        For j = 2 To x
            Bq(k, 0) = Br(i, 2) & "-" & j - 1
            Bq(k, 1) = Br(j, 1)
            Bq(k, 2) = Br(i, 2)
            Bq(k, 3) = Date + 1
            Bq(k, 4) = Date
            k = k + 1
        Next
    Next
    Sheets(1).Cells(2, 10).Resize(UBound(Bq) + 1, UBound(Bq, 2) + 1) = Bq
End Sub

 

[VenA]

Dan moet het volgens mij zoiets worden. Werkt ook als er meer gegevens in kolom A dan in kolom B staan.

Sub VenA()
Dim j As Long, jj As Long, t As Long, ar, ar1, ar2
  ar = Sheets(1).Columns(1).SpecialCells(2)
  ar1 = Sheets(1).Columns(2).SpecialCells(2)
  ReDim ar2((UBound(ar) - 1) * UBound(ar1) - 1, 4)
    For j = 2 To UBound(ar1)
      For jj = 2 To UBound(ar)
        ar2(t, 0) = ar1(j, 1) & "-" & jj - 1
        ar2(t, 1) = ar(jj, 1)
        ar2(t, 2) = ar1(j, 1)
        ar2(t, 3) = Date + 1
        ar2(t, 4) = Date
        t = t + 1
      Next jj
    Next j
    Sheets(1).Cells(2, 10).Resize(UBound(ar2) + 1, UBound(ar2, 2) + 1) = ar2
End Sub

Edit. Zoals Timshel ook al voor je gemaakt heeft maar dan net iets anders.

 

[janvdallas]

Dank Timshel & VenA