• 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.

formule met logische test

  • Onderwerp starter Onderwerp starter vovo
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
V

vovo

Gebruiker
Lid geworden
2 dec 2009
Berichten
98
hallo beste forumleden,

bestaat er een mogelijkheid om hetvolgende te bereiken; in kolomA staat er een klantnummer dat steeds begint met 56 en in totaal 8 cijfers telt. Boven deze klantnr staan telkens een aantal andere lijnen die ook bij diezelfde klant horen als je wilt.
Mijn bedoeling is nu om in kolom G automatisch dit klantennummer te copiëren naast alle lijnen die bij dat ene klantnummer horen. In neem aan dat dit met een if then zou moeten lukken maar helaas is mijn kennis onvoldoende...

In bijlage alvast een bestandje ter verduidelijking.

Bedankt voor julllie hulp !
VovoBekijk bijlage helpmij.xls
 
Hier een rudimentair macro'tje dat wel het nodige werk doet.

Code: 
Sub overname()
       For i = 735 To 1 Step -1
           If IsNumeric(Cells(i, 2)) Then
              Cells(i, 1) = Cells(i, 2)
                 nummer = Cells(i, 2)
          End If
         
          If IsNumeric(Cells(i, 2)) = 0 Then
              Cells(i, 1) = nummer
          End If
       Next
End Sub

Cobbe
 
Laatst bewerkt:
Cobbe zei:
Hier een rudimentair macro'tje dat wel het nodige werk doet.

Code: 
Sub overname()
       For i = 735 To 1 Step -1
            If IsNumeric(Cells(i, 1)) Then
            Cells(i, 7) = Cells(i, 1)
nummer = Cells(i, 1)
       End If
            If IsNumeric(Cells(i, 1)) = 0 Then
            Cells(i, 7) = nummer
       End If
Next
End Sub


Cobbe
Klik om te vergroten...

Super dat werkt inderdaad, maar blijkt niet te werken in een uitgebreider excelbestand met extra kolom en blanco lijntjes erin ?

Als ik het macrootje probeer te begrijpen, dan neem ik aan dat je met de 7 op kolom G duidt in het voorbeeldje of vergis ik me ?

Waar staat de "i" dan voor in de macro ?

Thanks.
 
Laatst bewerkt:
Hierbij een andere code zonder hulpkolommen.
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim i As Long
   For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
     With Sheets(1).Cells(i, 1)
    If IsNumeric(Cells(i, 1)) Then Cells(i, 7) = Cells(i, 1).Value
  End With
 Next
 Application.EnableEvents = False
     On Error Resume Next
    Range("G1:G" & Cells(Rows.Count, 7).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[1]C"
   Application.EnableEvents = True
 Application.ScreenUpdating = True
End Sub
 
vovo zei:
Super dat werkt inderdaad, maar blijkt niet te werken in een uitgebreider excelbestand met extra kolom en blanco lijntjes erin ?
QUOTE]

Het principe blijft hetzelfde moet ook werken met blanco rijen.
Die 7 verwijst naar kolom G en die i is een teller om telkens één rij op te schuiven.
In het bestand heb ik er een hulpkolom voorgeplaatst en de nummers daarin gezet en tevens in kolom H.
Kun je wissen wat er niet hoort.

Als je het principe van de macro begrijpt kun je ook de nodige aanpassingen doen.
Hij loop wel van onder naar boven omdat de aanvulling ook telkens naar boven moet aangevuld worden.

Ik hoop dat begrijpelijk is wat ik allemaal vertel.:)

Cobbe
Klik om te vergroten...
 
Als alternatief een relatief eenvoudige formule-aanpak. Matrixformule!
 

Bijlagen

Deze werkt op onbeperkte lengte en met blanco regels tussen
Code: 
Sub tst()
With Sheets("Sheet1")
sq = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
    For i = UBound(sq) To 1 Step -1
        If IsNumeric(sq(i, 1)) Then x = sq(i, 1)
        If Not IsNumeric(sq(i, 1)) And sq(i, 1) <> "" Then sq(i, 1) = x
    Next
    .[A1].Resize(UBound(sq)) = sq
End With
End Sub
 
een eenvoudige formule doet ook al wonderen
Code: 
=ALS(AANTALARG(A1:$A$1000)=0;"";ALS(EN(ISGETAL(A1);LENGTE(A1)=8);A1;G2))
 

Bijlagen

Cobbe zei:
vovo zei:
Super dat werkt inderdaad, maar blijkt niet te werken in een uitgebreider excelbestand met extra kolom en blanco lijntjes erin ?
QUOTE]

Het principe blijft hetzelfde moet ook werken met blanco rijen.
Die 7 verwijst naar kolom G en die i is een teller om telkens één rij op te schuiven.
In het bestand heb ik er een hulpkolom voorgeplaatst en de nummers daarin gezet en tevens in kolom H.
Kun je wissen wat er niet hoort.

Als je het principe van de macro begrijpt kun je ook de nodige aanpassingen doen.
Hij loop wel van onder naar boven omdat de aanvulling ook telkens naar boven moet aangevuld worden.

Ik hoop dat begrijpelijk is wat ik allemaal vertel.:)

Cobbe
Klik om te vergroten...

Prima en bedankt Cobbe !
zo ben ik ondertussen ook weeral een stapje verder geraakt in de "macro-kunde" !

Groeten,
Vovo
Klik om te vergroten...
 
HSV zei:
Hierbij een andere code zonder hulpkolommen.
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim i As Long
   For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
     With Sheets(1).Cells(i, 1)
    If IsNumeric(Cells(i, 1)) Then Cells(i, 7) = Cells(i, 1).Value
  End With
 Next
 Application.EnableEvents = False
     On Error Resume Next
    Range("G1:G" & Cells(Rows.Count, 7).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[1]C"
   Application.EnableEvents = True
 Application.ScreenUpdating = True
End Sub
Klik om te vergroten...

Beste HSV,

mijn macro/vba kennis is beperkt. Als je me nu nog kan uitleggen hoe ik een "private sub" moet starten dan kan ik het ineens testen? Sorry maar ik heb deze in de vba-editor geplakt maar dan stopt het voor mij.....

Groeten
vovo
 
Warme bakkertje zei:
Deze werkt op onbeperkte lengte en met blanco regels tussen
Code: 
Sub tst()
With Sheets("Sheet1")
sq = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
    For i = UBound(sq) To 1 Step -1
        If IsNumeric(sq(i, 1)) Then x = sq(i, 1)
        If Not IsNumeric(sq(i, 1)) And sq(i, 1) <> "" Then sq(i, 1) = x
    Next
    .[A1].Resize(UBound(sq)) = sq
End With
End Sub
Klik om te vergroten...

Beste warme bakkertje,

als ik deze macro gebruik, dan wordt bij mij enkel kolom A leeg gemaakt ?
 
cow18 zei:
een eenvoudige formule doet ook al wonderen
Code: 
=ALS(AANTALARG(A1:$A$1000)=0;"";ALS(EN(ISGETAL(A1);LENGTE(A1)=8);A1;G2))
Klik om te vergroten...

Beste Cow,

en dit werkt ook !

Jullie zijn geweldig bedankt !

Groeten Vovo
 
Hierbij het bestandje vovo.
Selecteer ergens een cel.
 
Laatst bewerkt:
HSV zei:
Hierbij het bestandje vovo.
Selecteer ergens een cel.
Klik om te vergroten...

Bedankt HSV,

dat werkt wel nu !
Mag ik je dan ook nog vragen hoe ik deze macro makkelijkst kan hergebruiken in een nieuw bestand en dat hij ook niet blijft lopen wanneer ik op een cel klik ?
 
Oeps.... het verkeerde bestandje.

Was meer een test voor evt. vevolg vraag.

Hierbij de andere.

Je vraag.

Kopiëer de code en plaats het in het ander bestand.
 

Bijlagen

HSV zei:
Oeps.... het verkeerde bestandje.

Was meer een test voor evt. vevolg vraag.

Hierbij de andere.

Je vraag.

Kopiëer de code en plaats het in het ander bestand.
Klik om te vergroten...


Beste HSV,

lukt me nog niet... heb het net in een ander uitgebreid bestand geplakt, waar het resultaat in kolom I moet komen.

Code: 
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim i As Long
   For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
     With Sheets(1).Cells(i, 1)
    If IsNumeric(Cells(i, 1)) Then Cells(i, 9) = Cells(i, 1).Value
  End With
 Next
 Application.EnableEvents = False
     On Error Resume Next
    Range("I1:I" & Cells(Rows.Count, 9).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[1]C"
   Application.EnableEvents = True
 Application.ScreenUpdating = True
End Sub
 
Laatst bewerkt door een moderator:
Zou moeten werken.
Iets aan ballast verwijderd.

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim i As Long
   For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    If IsNumeric(Cells(i, 1)) Then Cells(i, 9) = Cells(i, 1).Value
   Next
 Application.EnableEvents = False
     On Error Resume Next
    Range("I1:I" & Cells(Rows.Count, 9).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[1]C"
   Application.EnableEvents = True
 Application.ScreenUpdating = True
End Sub

Heb je het wel in de bladmodule geplaatst?
 
Zo doet hij wel wat de bedoeling is.
Code: 
Sub tst()
With Sheets("Sheet1")
sq = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
    For i = UBound(sq) To 1 Step -1
        If IsNumeric(sq(i, 1)) Then x = sq(i, 1)
        If Not IsNumeric(sq(i, 1)) And sq(i, 1) <> "" Then sq(i, 1) = x
    Next
    .[I1].Resize(UBound(sq)) = sq
End With
End Sub
 
HSV zei:
Zou moeten werken.
Iets aan ballast verwijderd.

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim i As Long
   For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    If IsNumeric(Cells(i, 1)) Then Cells(i, 9) = Cells(i, 1).Value
   Next
 Application.EnableEvents = False
     On Error Resume Next
    Range("I1:I" & Cells(Rows.Count, 9).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[1]C"
   Application.EnableEvents = True
 Application.ScreenUpdating = True
End Sub

Heb je het wel in de bladmodule geplaatst?
Klik om te vergroten...

Yep, in bladmodule geplaats maar hij doet niks ??
Sorry hoor....
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan