meerder kolommen naar een cel

[excelkees]

Hoi beste Forum, een vraagje: ik wil graag met een druk op de knop de nummers in kolom c (6000 items) bijwerken met de getallen in dezelfde regel van de kolommen D tot min kolom AA. Eea gescheiden met ; of -
Wie kan me helpen de macro die erbij zit vind ik niet zo goed, dank je wel Kees

 

[JEC.]

Probeer het eens met deze achter de knop

Sub jveer()
jv = Columns(3).SpecialCells(2)
 ReDim ar(UBound(jv), 2)
   For i = 1 To UBound(jv)
     a = Split(Mid(jv(i, 1), 3), "-")
     ar(i - 1, 0) = a(0)
     ar(i - 1, 1) = a(1)
     ar(i - 1, 2) = a(2)
   Next
Cells(1, 4).Resize(UBound(ar), 3) = ar
End Sub

of:

Sub jveer_2()
  With Columns(3).SpecialCells(2)
    .TextToColumns Range("D1"), 1, , , , , , , 1, "-"
    .Offset(, 1).Replace ": ", ""
  End With
End Sub

 

[HSV]

Of:

Sub hsv()
 Columns(3).TextToColumns Cells(1, 4), 1, , , , , , , -1, "-"
 Columns(4).Replace ": ", ""
End Sub

 

[edmoor]

Of:

For i = 1 To ActiveSheet.Cells(ActiveSheet.Rows.Count, "C").End(xlUp).Row
    Cells(i, 3) = Replace(Join(Application.Transpose(Application.Transpose(Range("C" & i & ":AA" & i))), "-"), "--", "")
Next i

 

[excelkees]

Typen komen niet overeen

Dank JV, Harry en Ed,
bij JV krijg ik de fout melding: Typen komen niet overeen
bij hsv wordt kolom c gekopieerd naar kolom 4
de kolommen d tot minimaal kolom AA staat een getal dat kan vervallen, na wijziging en klik in kolom C de nieuwe reeks zonder de vervallen en bestaande info in kolom C overschrijven met de nieuwe nummers,
groetjes en alvast dank je wel Kees

 

[VenA]

Klopt jouw voorbeeld wel met de wensen?

Rij 3,4 en 5 lijk je uitgewerkt te hebben daarna zet je overal dezelfde getallen. Je hebt het ook over gescheiden door ; of - . Is in het voorbeeld niet terug te vinden. De suggestie van @edmoor heb je niet getest?

 

[HSV]

Sub hsv()
 Application.DisplayAlerts = False
 Columns(3).TextToColumns Cells(1, 4), 1, , , , , , , -1, "-"
 Columns(4).Replace ": ", ""
 Columns(3).Delete
End Sub

Of:

Sub hsv()
 With Columns(3)
  .Offset(, 1).Resize(, 24).ClearContents
  .TextToColumns Cells(1, 4), 1, , , , , , , -1, "-"
  .Offset(, 1).Replace ": ", ""
  .Delete
 End With
End Sub

 

[VenA]

Ik denk dat zoiets de bedoeling is.

Sub VenA()
  Dim a(1 To 24), b, d, x, ar, j As Long, jj As Long
  Set d = CreateObject("Scripting.Dictionary")
  With Sheets("Blad1")
    ar = .Cells(3, 2).CurrentRegion
    For j = 1 To UBound(ar)
      b = a
      x = Split(ar(j, 2), "-")
      For jj = 0 To UBound(x)
        If IsNumeric(x(jj)) Then b(Val(x(jj))) = Val(x(jj))
      Next jj
      d(d.Count) = b
    Next j
    .Cells(15, 4).Resize(d.Count, 24) = Application.Index(d.items, 0, 0)
  End With
End Sub

 

[HSV]

Denk het ook; ik heb blad1 niet eens opgemerkt.
Het stond al standaard op Blad5.

 

[excelkees]

stel de vraag goed dan heb je meer kans op een goed resultaat

Beste VenA, JV, Harry en Ed, allereerst sorry voor het slecht stellen van mijn vraag.
het gaat idd over blad 1 en het resultaat moet in kolom C3 enz komen. telkens als je in een regel bijv d3:aa3 een nr weghaal en nadat je op de knop drukt, moet kolom C worden gewijzigd. de overgebleven nrs staan nu in cel C3 gescheiden met een -
voorbeeld: staat in M3: 10 en Z3: 23 dan staat in C3: 10-23
haal ik nu de 10 weg en druk op de knop dan staat in C3: 23

dank je wel alvast en groetjes Kees
https://www.helpmij.nl/forum/images/smilies/redface.gif

 

[VenA]

Dat kan in Excel365 eenvoudig met een formule

=TEXTJOIN("-";;D3:AA3)

 

[excelkees]

Naam? excel 2010

dank voor je antwoord VenA, maar de fout melding ongeldige naam, gr Kees
vlgs is textjoin er vanaf versie 2019, is er misschien iets mogelijk met CONCATENATE maar er zijn cellen in de rij leeg of worden leeg in de toekomst

 

[snb]

Kees,

Kun je een poging doen van je berichten leesbaar en begrijpelijk Nederlands te maken ?
Dit is tenslotte een Nederlandstalig forum.
Realiseer je ook dat er vele meelezers (zullen) zijn.
Een van de slimste uitvindingen is het gebruik van leestekens: hoofdletters, komma, punt, puntkomma, etc. Allemaal om het de lezer gemakkelijk te maken en om de effektiviteit van je communicatie te vergroten.

Jouw 'vraagstuk' is toch geen onderdeel van de registratie van Bingo ?
Het zou handig zijn het doel van deze tussenstap uit te leggen.
Voor je het weet krijg je dan ineens veel eenvoudiger suggesties aangereikt (tenzij dat niet je bedoeling is).

 

[VenA]

Dan maar een UDF
Bv

Function VenA(r As Range, s As String) As String
  ar = r
  For j = 1 To UBound(ar, 2)
    If ar(1, j) <> "" Then c00 = c00 & s & ar(1, j)
  Next j
  If Len(c00) Then VenA = Mid(c00, 2)
End Function

In C3

=vena(D3:AA3;"-")

 

[excelkees]

geen bingo

beste VenA, geweldig, precies wat ik zocht, daaaank, groetjes Kees

Beste JV, Harry en Ed, ook jullie bedankt

hoi snb, mijn 'vraagstuk' is geen onderdeel van de registratie van Bingo. je hebt gelijk ben daar slordig in, daarom had ik al sorry geschreven. Dit is een lijst van mijn verzameling. De nrs die ik nog niet zijn heb, wil ik in cel C3, C4 enz zien zodat ik die kan uitprinten.

 

[snb]

De titel van deze draad is nog steeds 100% diametraal ten opzichte van je vraag.

 

[HSV]

Ook maar een duit.

Function hsv(r As Range) As String
hsv = Join(Filter(Evaluate("if(" & r.Address & "<>""""," & r.Address & ",""~"")"), "~", 0), "-")
End Function

=hsv(d3:aa3)

Of de separator in de function.

Function hsv(r As Range, s As String) As String
hsv = Join(Filter(Evaluate("if(" & r.Address & "<>""""," & r.Address & ",""~"")"), "~", 0), s)
End Function

=hsv(d3:aa3;"-")