Snel pipetekens maken

tshw3 · 12 aug 2022

Goedemiddag Helpmij leden,

Ik heb een vraag om snel pipetekens te zetten tussen bepaalde waardes.

Situate: Binnen ons bedrijf gebruiken we software dat filtert met pipetekens.
Als ik dus een filter wil bouwen van verschillende nummers of klanten dan krijg je:

Je hebt waardes:
1
2
3

het filter moet dan zijn 1|2|3

Nu kan zo'n filter wel meer dan 1000 of wel paar duizend regels bevatten waar dan allemaal een | teken tussen moet.

Wat wil ik graag bereiken:
Je hebt kolom a: hier plak je de waardes wat je in pipetekens wilt hebben:
Dus A1 = 1
A2 = 2
A3 = 3
Tot en met oneindig

Vervolgens zoek ik een formule die in één cel deze waarde met pipetekens neerzet dus 1|2|3 en vervolgens stopt als het geen celwaarde meer is in kolom A en eindigt zonder een |

Wat heb ik al geprobeerd?
Het idee van mij was het volgende (zie bijlage)
Ik vul kolom A
Ik converteer de waardes (nu ik dit schrijf is dit best wel overbodig...) wat controleert of cel gevuld is: =ALS($A1="";"";$A1)
Vervolgens met tekst.samenvoegen er een pipeteken tussen zetten dus: =TEKST.SAMENVOEGEN(E2;"|";F2;"|";G2)

Het probleem is dat ik nooit weer hoe lang kolom A wordt en wanneer het dus moet stoppen om pipetekens te plaatsen.
Kan iemand mij op weg helpen?

Bekijk bijlage Snel pipetekens maken.xlsx

AHulpje · 12 aug 2022

Lijkt mij een omslachtige en arbeidsintensieve methode, dus dat moet veel beter kunnen.
Hoe ziet de gegevensbron er uit? Tekstbestand, Excelbestand, meerdere kolommen?
Waar moet het resultaat naar toe? Database, tekstbestand, Excelbestand, meerdere regels?

tshw3 · 12 aug 2022

AHulpje zei:
Lijkt mij een omslachtige en arbeidsintensieve methode, dus dat moet veel beter kunnen.
Hoe ziet de gegevensbron er uit? Tekstbestand, Excelbestand, meerdere kolommen?
Waar moet het resultaat naar toe? Database, tekstbestand, Excelbestand, meerdere regels?

Ik begrijp dat het omslachtig klinkt:
Het proces is dat er bepaalde data uit x applicatie komt in een excel bestand -> dit gebruik je om vervolgens een filter te bouwen die je weer kan gebruiken op verschillende manieren.
Dit filter kan je plakken in verschillende omgevingen etc. dus het moet echt platte tekst zijn.

Inmiddels aan het stoeien met deze info:
https://www.excelcampus.com/tips-shortcuts/concatenate-range-of-cells/

AlexCEL · 12 aug 2022

Het proces is dat er bepaalde data uit x applicatie komt in een excel bestand

En hoe ziet dit er dan uit? Met Power Query is misschien wel wat mogelijk.

Voor Excel 365:

Code:

=TEKST.COMBINEREN("|";WAAR;A:A)

AHulpje · 12 aug 2022

Wordt de export uit applicatie x rechtstreeks in Excel gezet of importeer je die data vanuit een tekstbestand.
Als het een tekstbestand betreft, hoe ziet dat er dan uit? Heb je misschien een voorbeeldje?
Welke versie van Excel gebruik je?

tshw3 · 12 aug 2022

AlexCEL zei:
En hoe ziet dit er dan uit? Met Power Query is misschien wel wat mogelijk.

Voor Excel 365:

Code:

=TEKST.COMBINEREN("|";WAAR;A:A)

Het is niet zo dat het altijd uit de omgeving komt dus koppelen gaat in die zin niet werken.
Power Query is mij nog onbekend, moet ik even uitzoeken. Maar dat run je binnen je excel file?
EDIT2: ik zie dat dit inderdaad een connectie is, dit is helaas geen optie. Het moet echt binnen excel.

Als tweede reactie:
Ik gebruik excel 365 desktop. Uit de applicatie is het letterlijk een export knop dus ik zie een tabel in de applicatie -> export naar excel en vervolgens krijg ik dezelfde tabel in excel.
Hier kopieer ik dan de waarde uit bijvoorbeeld klantnummer 1 2 3 en daar wil ik dan een string van maken.

tshw3 · 12 aug 2022

Onderstaand doet precies wat ik wil, echter te complex...

Code:

Sub Concatenate()
    'Creates a basic CONCATENATE formula with no options
    Call Concatenate_Formula(True, False)
End Sub

Wat vervolgens uitvoert:

Code:

Sub Concatenate_Formula(bConcat As Boolean, bOptions As Boolean)

Dim rSelected As Range
Dim c As Range
Dim sArgs As String
Dim bCol As Boolean
Dim bRow As Boolean
Dim sArgSep As String
Dim sSeparator As String
Dim rOutput As Range
Dim vbAnswer As VbMsgBoxResult
Dim lTrim As Long
Dim sTitle As String

    Set rOutput = ActiveCell
    bCol = False
    bRow = False
    sSeparator = ""
    sTitle = IIf(bConcat, "CONCATENATE", "Ampersand")
    
    On Error Resume Next
    Set rSelected = Application.InputBox(Prompt:= _
                    "Select cells to create formula", _
                    Title:=sTitle & " Creator", Type:=8)
    On Error GoTo 0
    
    If Not rSelected Is Nothing Then
        
        sArgSep = IIf(bConcat, ",", "&")
        
        If bOptions Then
        
            vbAnswer = MsgBox("Columns Absolute? $A1", vbYesNo)
            bCol = IIf(vbAnswer = vbYes, True, False)
            
            vbAnswer = MsgBox("Rows Absolute? A$1", vbYesNo)
            bRow = IIf(vbAnswer = vbYes, True, False)
                
            sSeparator = Application.InputBox(Prompt:= _
                        "Type separator, leave blank if none.", _
                        Title:=sTitle & " separator", Type:=2)
        
        End If
        
        For Each c In rSelected.Cells
            sArgs = sArgs & c.Address(bRow, bCol) & sArgSep
            If sSeparator <> "" Then
                sArgs = sArgs & Chr(34) & sSeparator & Chr(34) & sArgSep
            End If
        Next
        
        lTrim = IIf(sSeparator <> "", 4 + Len(sSeparator), 1)
        sArgs = Left(sArgs, Len(sArgs) - lTrim)

        If bConcat Then
            rOutput.Formula = "=CONCATENATE(" & sArgs & ")"
        Else
            rOutput.Formula = "=" & sArgs
        End If
        
    End If

End Sub

Echter al die keuzes hoef ik niet en heb ik het liefst dat ik niet hoef te selecteren maar gewoon in kolom A kijkt.

Volgensmij krijg je dan zoiets:

Code:

  On Error Resume Next
  sn = Blad1.Cells(1).CurrentRegion
    For j = 2 To UBound(sn)

en dan de message boxen eruit en een pipeteken, werkend krijg ik het alleen nog niet

AlexCEL · 12 aug 2022

Ik gebruik excel 365 desktop.

En heb je dan ook de formule uit #4 geprobeerd?

Code:

=TEKST.COMBINEREN("|";WAAR;A:A)

tshw3 · 12 aug 2022

AlexCEL

Op de een of andere manier dacht ik dat het niet werkte... apart.
Ik heb het getest en het werkt!

Dankjewel en fijn dat jullie zo snel konden reageren.

Alvast een fijn weekend.

snb · 12 aug 2022

Twee methodes in VBA:

Code:

Sub M_snb()
  sn = Cells(1).CurrentRegion
   
  MsgBox Join(Application.Transpose(sn), "|")
End Sub

Code:

Sub M_snb_001()
  sn = Cells(1).CurrentRegion
   
  For j = 1 To UBound(sn)
    c00 = c00 & "|" & sn(j, 1)
  Next
   
  MsgBox c00
End Sub

NB. Realiseer je wel dat een cel slechts een beperkt aantal tekens kan bevatten.

tshw3 · 12 aug 2022

snb zei:
NB. Realiseer je wel dat een cel slechts een beperkt aantal tekens kan bevatten.

Bedankt voor de input en goede opmerking en loop ik nu net toevallig tegenaan.
Ik deed dit altijd handmatig dus:

Bestand komt in excel
Waardes transponeren
Kopiëren
Plakken in notepad++
Lege waarde kopiëren
Alles selecteren en vervang lege waarde met |
Hierdoor kreeg ik altijd een lange string terug

In excel loop ik inderdaad tegen het limiet aan.
Zijn er wellicht mogelijkheden dat je de macro gebruikt en de string wordt gekopieerd naar het klembord?

AHulpje · 12 aug 2022

Code:

Sub PipeExport()
    Dim PipeFile
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set PipeFile = FSO.CreateTextFile(ActiveWorkbook.Path & "\Pipefile.txt")

    sn = Cells(1).CurrentRegion
   
    For j = 1 To UBound(sn)
        PipeFile.Write "|" & sn(j, 1)
    Next
   
    PipeFile.Close
    MsgBox "Resultaat in " & ActiveWorkbook.Path & "\Pipefile.txt"
End Sub

snb · 12 aug 2022

En waar moet het dan heen na het klembord ?
Kortom: wat moet het eindresultaat zijn ?

Code:

Sub M_snb()
  createobject("scripting.filesystemobject").createtextfile( "G:\OF\pijp.txt").write Join(Application.Transpose(Cells(1).CurrentRegion), "|")
End Sub

of

Code:

Sub M_snb_001()
  sn = Cells(1).CurrentRegion
   
  For j = 1 To UBound(sn)
    c00 = c00 & "|" & sn(j, 1)
  Next
   
  createobject("scripting.filesystemobject").createtextfile( "G:\OF\pijp.txt").write c00
End Sub

NB. Ook Application.transpose heeft beperkingen; vandaar de tweede variant.

JEC. · 12 aug 2022

Andere variant, rekeninghouden met eventuele lege cellen:

Code:

Sub jec()
Set Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
Open ThisWorkbook.Path & "\test.txt" For Output As #1
Print #1, Join(Filter(Evaluate("transpose(if(len(" & Rng.Address & ")," & Rng.Address & "))"), False, 0), "|")
Close #1
End Sub

JEC. · 12 aug 2022

Plakken in notepad++
Lege waarde kopiëren

Bij 1 lege cel is currentregion niet meer juist in dit geval

JEC. · 12 aug 2022

Of als je de data gelijk wilt kopiëren naar de eindbestemming, kan je na het runnen van onderstaande macro's direct met cntrl + V plakken.

Code:

Sub jec()
  Dim it, sp
  For Each it In Range("A1", Range("A" & Rows.Count).End(xlUp))
    If it.Value <> "" Then sp = sp & it.Value & "|"
  Next
    
  With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .SetText sp
    .PutInClipboard
  End With
End Sub

Of

Code:

Sub jec()
 Dim rng
 Set rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
 With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .SetText Join(Filter(Evaluate("transpose(if(len(" & rng.Address & ")," & rng.Address & "))"), False, 0), "|")
    .PutInClipboard
 End With
End Sub

tshw3 · 15 aug 2022

Goedenavond allen,

Dank voor alle feedback, excuses voor mijn late reactie...
Ik ben onverwachts nogal druk geweest

.

Als ik dit run:

Code:

Sub M_snb_001()
  sn = Cells(1).CurrentRegion
   
  For j = 1 To UBound(sn)
    c00 = c00 & "|" & sn(j, 1)
  Next
   
  CreateObject("scripting.filesystemobject").createtextfile("C:\Users\Teun\pijp.txt").write c00
End Sub

Dan krijg ik geen foutmelding, maar het creëert ook geen foutmelding of zet het bestandje in mijn downloads neer (heb natuurlijk wel de locatie goed aangepast).

Bij dit script:

Code:

Sub jec1()
  Dim it, sp
  For Each it In Range("A1", Range("A" & Rows.Count).End(xlUp))
    If it.Value <> "" Then sp = sp & it.Value & "|"
  Next
    
  With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .SetText sp
    .PutInClipboard
  End With
End Sub

Krijg ik onderstaand?

snb · 15 aug 2022

Dan gaat er aan jouw kant toch wel iets mis:
Je moet de macro in de macromodule van het aktieve blad zetten.
en gebruik in de Editor F8 om de macro stap-voor-stap uit te voeren en de waarden van variabelen te zien.
Debugging is het voorrecht van de vragensteller.

Code:

Sub M_snb_001()
  sn = Cells(1).CurrentRegion
   
  For j = 1 To UBound(sn)
    c00 = c00 & "|" & sn(j, 1)
  Next
   
  CreateObject("scripting.filesystemobject").createtextfile("C:\Users\Teun\pijp.txt").write c00
  msgbox dir("C:\Users\Teun\pijp.txt")
End Sub

tshw3 · 16 aug 2022

Hallo SNB,

Dank weer voor de feedback, ik heb het werkend.
Ik kreeg eerst een fout 70 maar inmiddels opgelost en nu wordt er ook een text file gegenereerd.
Bekijk bijlage 365889

Het enige wat nu nog gedaan wordt, maar is geen ramp:
|000|001|002|003|004|005|006|007|008|009|010|011|012|013

Er wordt een pipeteken voor gezet en moet zijn:
000|001|002|003|004|005|006|007|008|009|010|011|012|013

Ik ben hier al ontzettend blij mee, grote dank!

Nu heb ik dit:

Code:

Sub maak_pipetekens()
  sn = Cells(1).CurrentRegion
   
  For j = 1 To UBound(sn)
    c00 = c00 & "|" & sn(j, 1)
  Next
   
  CreateObject("scripting.filesystemobject").CreateTextFile("C:\Users\Teun\Downloads\pipetekensbestand.txt").write c00
    returnvalue = Shell("notepad.exe " & "C:\Users\Teun\Downloads\pipetekensbestand.txt", vbNormalFocus)
    
 ' MsgBox ("Pipetekensbestand is gecreeërd in de jouw opgegeven map.")
End Sub

Is er ook een manier om dit standaard op te slaan of in %user% downloads of in dezelfde map als waar het excel bestand staat opgeslagen?
Dus zoiets als filename = ThisWorkbook.Path & "\textfile

jkpieterse · 16 aug 2022

De PutInClipboard methode werkt niet als er een Windows verkenner venster open staat.

Snel pipetekens maken

Gebruiker

Terugkerende gebruiker

Gebruiker

Meubilair

Terugkerende gebruiker

Gebruiker

Gebruiker

Meubilair

Gebruiker

Verenigingslid

Gebruiker

Terugkerende gebruiker

Verenigingslid

Terugkerende gebruiker

Terugkerende gebruiker

Terugkerende gebruiker

Gebruiker

Verenigingslid

Gebruiker

Terugkerende gebruiker

Wij waarderen jouw privacy