Kolom toevoegen aan einde van sheet / macro toewijzen aan kolomnaam

Status
Niet open voor verdere reacties.
T

T0mmekedc

Nieuwe gebruiker
Lid geworden
4 mrt 2008
Berichten
3
Ik heb een excel sheet waarin adresgegevens van klanten staan. Nu zou er op het einde van de sheet 2 kolommen toegevoegd moeten worden dmv een macro.

Probleem is, niet elke sheet van klanten heeft gelijke aantal kolommen.

Dus de macro zou autmatisch het einde van de sheet moeten zien, en dan 2 kolommen toevoegen met de titels 'NP/P' en 'Land'


Mijn tweede probleem is het volgende:

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


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:
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
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan