susanthuis
Gebruiker
- Lid geworden
- 5 mei 2008
- Berichten
- 200
Dat ziet er goed uit, zeg!
Ik weet niet hoe je het hebt gedaan maar dat zoek ik nog wel uit:thumb:
Ik weet niet hoe je het hebt gedaan maar dat zoek ik nog wel uit:thumb:
Bekijk de onderstaande video om te zien hoe je onze site als een web app op je startscherm installeert.
Opmerking: Deze functie is mogelijk niet beschikbaar in sommige browsers.
Privacywetgeving
Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.
Sub M_snb()
sn = Cells(1).CurrentRegion
With CreateObject("Scripting.dictionary")
For j = 2 To UBound(sn)
If InStr(.Item(sn(j, 2)) & ";", ";" & sn(j, 3) & ";") = 0 Then .Item(sn(j, 2)) = .Item(sn(j, 2)) & ";" & sn(j, 3)
Next
Open "G:\OF\export.csv" For Append As #1
For j = 0 To .Count - 1
Print #1, .Keys()(j) & vbTab & .Item(.Keys()(j))
Next
Close
End With
End Sub
Doe dus geen moeite want met power query gaat het helaas fout.Ik weet niet hoe je het hebt gedaan maar dat zoek ik nog wel uit
Sub Verwerk()
Dim r As Long
Dim a As String
Dim r3 As Long
[COLOR=#008000]'Ontdubbelen[/COLOR]
ActiveSheet.Range("A:C").RemoveDuplicates Columns:=Array(2, 3), Header:=xlYes
r3 = 1
r = 3
a = Cells(2, 3) & ";"
e = Cells(2, 2)
Do While e <> vbNullString
Do While Cells(r, 2) = e
If Len(a & Cells(r, 3)) < 32766 Then
a = a & Cells(r, 3) & ";"
r = r + 1
Else
Sheets("Output").Cells(r3, 1) = e
Sheets("Output").Cells(r3, 2) = a
MsgBox "Resultaat voor " & e & " was langer dan 32767 karakters, is nu gesplitst."
a = ""
r3 = r3 + 1
End If
Loop
Sheets("Output").Cells(r3, 1) = e
Sheets("Output").Cells(r3, 2) = a
r3 = r3 + 1
e = Cells(r, 2)
a = ""
Loop
MsgBox "Zie werkblad Output"
Application.Goto Sheets("Output").Range("A1")
End Sub
Jouw voorbeeld uit #36 met 7455 rijen bevat slechts 20 unieke waarden in kolom B + C. Is kolom A nog van belang?
De dubbele waarden kunnen met de macro eenvoudig verwijderd worden:
Code:Sub Verwerk() Dim r As Long Dim a As String Dim r3 As Long [COLOR=#008000]'Ontdubbelen[/COLOR] ActiveSheet.Range("A:C").RemoveDuplicates Columns:=Array(2, 3), Header:=xlYes r3 = 1 r = 3 a = Cells(2, 3) & ";" e = Cells(2, 2) Do While e <> vbNullString Do While Cells(r, 2) = e If Len(a & Cells(r, 3)) < 32766 Then a = a & Cells(r, 3) & ";" r = r + 1 Else Sheets("Output").Cells(r3, 1) = e Sheets("Output").Cells(r3, 2) = a MsgBox "Resultaat voor " & e & " was langer dan 32767 karakters, is nu gesplitst." a = "" r3 = r3 + 1 End If Loop Sheets("Output").Cells(r3, 1) = e Sheets("Output").Cells(r3, 2) = a r3 = r3 + 1 e = Cells(r, 2) a = "" Loop MsgBox "Zie werkblad Output" Application.Goto Sheets("Output").Range("A1") End Sub
We gebruiken essentiële cookies om deze site te laten werken, en optionele cookies om de ervaring te verbeteren.