Archief - [PROG]VBA Macro Toewijzen aan kolomtitel

Het archief is een bevroren moment uit een vorige versie van dit forum, met andere regels en andere bazen. Deze posts weerspiegelen op geen enkele manier onze huidige ideeën, waarden of wereldbeelden en zijn op sommige plaatsen gecensureerd wegens ontoelaatbaar. Veel zijn in een andere tijdsgeest gemaakt, al dan niet ironisch - zoals in het ironische subforum Off-Topic - en zouden op dit moment niet meer gepost (mogen) worden. Toch bieden we dit archief nog graag aan als informatiedatabank en naslagwerk. Lees er hier meer over of start een gesprek met anderen.
F

Fartman

Legacy Member
Een macro kan mn toewijzen aan een kolom in excel (A, B, C, ...)

Maar kan mn ook een macro toewijzen aan een kolomtitel?

Ik heb hier namelijk een excel sheet waar de straat en straatnummer in dezelfde cel staan, en deze zouden elk in een apparte kolom moeten staan.

Maar deze macro moet ook toegepast worden op andere sheets, en daar staat de straat+nummer niet altijd in dezelfde kolom (soms A,B,C,...)

Iemand een idee hoe ik dit kan oplossen?

ps: Is het misschien mogelijk dat wanneer je de macro opstart, de macro vraagt op welke kolom hy moet toegepast worden?

thx
S

Suicide Monkey

Legacy Member
Als je in de editor een form maakt kan je vb een textbox toevoegen waarin je de kolom moet opgeven
F

Fartman

Legacy Member
Nog even mn situatie schetsen:

Adres staat in bijvoorbeeld kolom F in de vorm 'Dennelaan 34 bus 4'.


Mbv een macro zou dus naast kolom F 3 nieuwe kolommen moeten gemaakt worden, met in de eerste kolom 'Dennelaan', tweede kolom '34' en in de derde kolom '4'

De macro heb ik al gemaakt, maar deze is dus zoals je ziet toegepast op een vaste kolom, hiervoor zou ik dus een input willen waarin je de kolom kan kiezen.

Code: 
Sub Splits3()
'
' Splits3 Macro
'

'
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("F:F").Select
    Selection.Copy
    Columns("G:G").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "MailIDStraat"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "MailIDNummer"
    Columns("G:G").Select
    Selection.Replace What:=" 1", Replacement:=";1", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" 2", Replacement:=";2", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" 3", Replacement:=";3", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" 4", Replacement:=";4", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" 5", Replacement:=";5", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" 6", Replacement:=";6", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" 7", Replacement:=";7", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" 8", Replacement:=";8", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" 9", Replacement:=";9", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("G:G").Select
    Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    ActiveWindow.SmallScroll Down:=-21
    Range("H10").Select
    ActiveWindow.SmallScroll Down:=-12
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "MailIDNummer"
    Range("H3").Select
    ActiveWindow.SmallScroll Down:=51
    Columns("H:H").Select
    Range("H52").Activate
    Selection.Replace What:="bus", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ActiveWindow.SmallScroll Down:=-15
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    Columns("I:I").Select
    Range("I37").Activate
    Selection.Cut
    Columns("J:J").Select
    Range("J37").Activate
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-54
    Columns("H:H").Select
    Selection.Replace What:=" a", Replacement:=";a", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" b", Replacement:=";b", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" c", Replacement:=";c", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" d", Replacement:=";d", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" e", Replacement:=";e", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" f", Replacement:=";f", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" g", Replacement:=";g", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" h", Replacement:=";h", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" i", Replacement:=";i", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" j", Replacement:=";j", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" k", Replacement:=";k", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" l", Replacement:=";l", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" m", Replacement:=";m", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" n", Replacement:=";n", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" o", Replacement:=";o", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" p", Replacement:=";p", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" q", Replacement:=";q", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" r", Replacement:=";r", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" s", Replacement:=";s", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" t", Replacement:=";t", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" u", Replacement:=";u", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" v", Replacement:=";v", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" w", Replacement:=";w", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" x", Replacement:=";x", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" y", Replacement:=";y", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" z", Replacement:=";z", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    ActiveWindow.SmallScroll Down:=-27
    Columns("I:I").Select
    Selection.Copy
    Columns("J:J").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    ActiveWindow.SmallScroll Down:=66
    Range("J74").Select
    ActiveWindow.SmallScroll Down:=-93
    Columns("I:I").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "MailIDBusnr"
    Range("I2").Select
End Sub

Ik zet dus voor elk huisnummer een puntkomma, en kies Tekst naar Kolommen om dus de straatnaam van het huisnummer te splitsen.

Ik doe hetzelfde voor het woord bus.
Ik heb dit gedaan mbv Macro opnemen, omdat ik een beginner ben in VB :)
Het archief is een bevroren moment uit een vorige versie van dit forum, met andere regels en andere bazen. Deze posts weerspiegelen op geen enkele manier onze huidige ideeën, waarden of wereldbeelden en zijn op sommige plaatsen gecensureerd wegens ontoelaatbaar. Veel zijn in een andere tijdsgeest gemaakt, al dan niet ironisch - zoals in het ironische subforum Off-Topic - en zouden op dit moment niet meer gepost (mogen) worden. Toch bieden we dit archief nog graag aan als informatiedatabank en naslagwerk. Lees er hier meer over of start een gesprek met anderen.
Terug
Bovenaan