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

Melding voorzien indien LKxxx niet in lijst voorkomt

Status
Niet open voor verdere reacties.
Beste HSV,

Plaats anders de codes in een nieuwe Sub gegevens_BTR en Sub gegevens_BGE
Ik plaats de codes dan waar ze moeten staan
Starten wordt gedaan vanaf iRowstart +1

Code: 
        Sheets("Systeem").Range("CHBTRStart").Value = Range("CHEinde") + 2
              
        iRowStart = Range("CHBTRStart")
        
        Range("ColumnHeaderBTR").Copy Sheets(mySheetName).Range("A" & iRowStart)

Code hieronder...

Voor Sub gegevens_GBE, is dit hetzelfde enkel starten vanaf iRowStart +1

Code: 
        Sheets("Systeem").Range("CHBGEStart") = Range("CHBTREinde").Value + 2

        iRowStart = Range("CHBGEStart")
    
        Range("ColumnHeaderBGE").Copy Sheets(mySheetName).Range("A" & iRowStart)

Code hieronder
 
Ik heb het verwerkt in de code "Vervolg".
Het bestand "'planningBGE" heb ik niet in bezit, ik heb dat stuk code als tekst gemarkeerd.
 

Bijlagen

Beste HSV,

Dit werkt met enige aanpassing, deze zijn:

Code: 
Dim strTwo As Long
strTwo = Sheets("Systeem").Range("LK_Row_nummer")
         .AutoFilter 7, Blad10.Cells(strTwo, 3) & "*"

Nu zou ik een melding willen wanneer er geen en wel gegevens zijn

Code: 
MsgBox "Geen BTR gegevens gevonden voor loopkraan """ & str & """", vbOKOnly, "Loopkraan gegevens:"
MsgBox "Alle BTR gegevens zijn opgehaald voor loopkraan """ & str & """", vbOKOnly, "Loopkraan gegevens:"

Code: 
MsgBox "Geen BGE gegevens gevonden voor loopkraan """ & str & """", vbOKOnly, "Loopkraan gegevens:"
MsgBox "Alle BGE gegevens zijn opgehaald voor loopkraan """ & str & """", vbOKOnly, "Loopkraan gegevens:"

Kan je deze MsgBoxen ergens tussen plaatsen ?
 
Dat doet me deugd.

Laatste gedeelte van "Vervolg" veranderen in:
Code: 
ActiveWorkbook.Close 0
      If n > 0 Then
        Sheets(mySheetName).Range("A" & iRowStart + 1).Offset(1).Resize(n - 1, 10) = arr
        MsgBox "Alle BTR gegevens zijn opgehaald voor loopkraan """ & str & """", vbOKOnly, "Loopkraan gegevens:"
       Else
        MsgBox "Geen BTR gegevens gevonden voor loopkraan """ & str & """", vbOKOnly, "Loopkraan gegevens:"
      End If
    End With
  End With
End With


'===================================================
 
Laatst bewerkt:
Beste HSV,

Voortdurend getest en toch nog een detailtje gevonden:

Hoe komt het dat de gegevens voor BGE pas op de 5e regel geschreven wordt en niet direct onder CHBGEStart +1
dit veranderd in Range("A1000").End(xlUp).Offset(1) maar blijft hetzelfde.

In bijlage heb ik 4 bestandjes geplaatst voor te testen.
Planning Danny5.xlsb
Output Danny.xlsx
PlanningEXT.xlsm
PlanningBGE.xlsm

Men kan testen op volgende LK's

Op tabblad ME-1_RE-1 --> datum 1/2 --> testen met LK105 --> OK
Op tabblad ME-1_RE-1 --> datum 2/2 --> testen met LK100 --> NOK
Op tabblad ME-1_RE-1 --> datum 3/2 --> testen met LK100 --> NOK

Als je een gaatje ziet mag je er eens nakijken :D
 

Bijlagen

Zie aangepaste rode tekst Danny.
Code: 
Sub vervolg()
Dim strTwo As Long
mySheetName = ActiveSheet.Name
strTwo = Sheets("Systeem").Range("LK_Row_nummer")
Application.ScreenUpdating = False


        Sheets("Systeem").Range("CHEinde").Value = Sheets(mySheetName).Range("B1000").End(xlUp).row


        iRowEinde = Range("CHEinde")
        iRowStart = Range("CHStart")


        Sheets(mySheetName).Rows(iRowStart + 1 & ":" & iRowEinde).Rows.Group
    
        Sheets("Systeem").Range("CHBTRStart").Value = Range("CHEinde") + 2
              
        iRowStart = Range("CHBTRStart")
        
        Range("ColumnHeaderBTR").Copy Sheets(mySheetName).Range("A" & iRowStart)


Workbooks.Open ThisWorkbook.path & "\planningExt.xlsm"
 With ActiveWorkbook
  Set twb = ThisWorkbook.ActiveSheet
   With Workbooks("planningExt.xlsm").Sheets("Blad2")
    With .Cells(1).CurrentRegion
     If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
         .AutoFilter 1, ">=" & CLng(twb.Cells(1, 3)), 1, "<=" & CLng(twb.Cells(1, 3))
         .AutoFilter 7, Blad10.Cells(strTwo, 3) & "*"
                sn = .Cells(1).CurrentRegion
                     ReDim arr(0 To UBound(sn) - 1, 0 To 12)
                       For i = 2 To UBound(sn)
                        If Not .Rows(i).Hidden Then
                           For j = 1 To UBound(sn, 2)
                                arr(n, 0) = sn(i, 3)
                                arr(n, 1) = sn(i, 9)
                                arr(n, 2) = sn(i, 10)
                                arr(n, 7) = sn(i, 5)
                                arr(n, 10) = sn(i, 2)
                                arr(n, 12) = sn(i, 8)
                            Next j
                      n = n + 1
                    End If
            Next i
        ActiveWorkbook.Close 0
      If n > 0 Then
        Sheets(mySheetName).Range("A1000").End(xlUp).Offset(1).Resize(n, 12) = arr
        MsgBox "Alle BTR opdrachten zijn opgehaald voor loopkraan """ & str & """", vbInformation + vbOKOnly, "Loopkraan gegevens:"
        opmaak_BTR
       Else
        MsgBox "Geen BTR opdrachten gevonden voor loopkraan """ & str & """", vbInformation + vbOKOnly, "Loopkraan gegevens:"
      End If
    End With
  End With
End With
[SIZE=5][COLOR=#ff0000]n = 0[/COLOR][/SIZE]
        Range("CHBTREinde").Value = Sheets(mySheetName).Range("c1000").End(xlUp).row


        iRowEinde = Range("CHBTREinde").Value
           
        Sheets(mySheetName).Rows(iRowStart + 1 & ":" & iRowEinde).Rows.Group
          
        Sheets("Systeem").Range("CHBGEStart") = Range("CHBTREinde").Value + 2
        iRowStart = Range("CHBGEStart")
    
        Range("ColumnHeaderBGE").Copy Sheets(mySheetName).Range("A" & iRowStart)


Workbooks.Open ThisWorkbook.path & "\planningBGE.xlsm"
 With ActiveWorkbook
  Set twb = ThisWorkbook.ActiveSheet
   With Workbooks("planningBGE.xlsm").Sheets("Blad2")
    With .Cells(1).CurrentRegion
     If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
         .AutoFilter 1, ">=" & CLng(twb.Cells(1, 3)), 1, "<=" & CLng(twb.Cells(1, 3))
         .AutoFilter 7, Blad10.Cells(strTwo, 3) & "*"
                sn = .Cells(1).CurrentRegion
                     ReDim arr(0 To UBound(sn) - 1, 0 To 12)
                       For i = 2 To UBound(sn)
                        If Not .Rows(i).Hidden Then
                           For j = 1 To UBound(sn, 2)
                                arr(n, 0) = sn(i, 3)
                                arr(n, 1) = sn(i, 9)
                                arr(n, 2) = sn(i, 10)
                                arr(n, 7) = sn(i, 5)
                                arr(n, 10) = sn(i, 2)
                                arr(n, 12) = sn(i, 8)
                            Next j
                      n = n + 1
                    End If
            Next i
        ActiveWorkbook.Close 0
        Sheets(mySheetName).Range("A1000").End(xlUp).Offset(1).Resize(n, 13) = arr
        MsgBox "Alle BGE opdrachten zijn opgehaald voor loopkraan """ & str & """", vbInformation + vbOKOnly, "Loopkraan gegevens:"
        opmaak_BGE
       Else
        MsgBox "Geen BGE opdrachten gevonden voor loopkraan """ & str & """", vbInformation + vbOKOnly, "Loopkraan gegevens:"
      End If
    End With
  End With
End With
[SIZE=5][COLOR=#ff0000]n = 0[/COLOR][/SIZE]
        Range("CHBGEEinde").Value = Sheets(mySheetName).Range("c1000").End(xlUp).row


        iRowEinde = Range("CHBGEEinde")


        Rows(iRowStart + 1 & ":" & iRowEinde).Rows.Group
        
        iRowStart = Range("IBNStart")
        
        Rows(iRowStart - 1 & ":" & iRowEinde + 1).Rows.Group


        Range("A" & iRowStart + 4).Select


        Application.ScreenUpdating = True
End Sub
 
Beste HSV,

Heb hier geen woorden voor maar....

BEDANKT VOOR ALLES.

'k zou zeggen, laten we der enen gaan pakken :D

Mijn vorig record van 180 reacties van 2012 is hiermee weeral verbroken :thumb:
 
Hoi Danny,

Ik juich nog niet te vroeg. :d:d
Wat een topic was dit.
Ik ben blij voor je dat het is gelukt.

Hier nog even wat quotes uit de bijdragen.


HSV zei:
Danny,
Helaas had ik er geen zin in; het is monnikenwerk om al die begrippen te onderscheiden daar je nergens naar kolommen verwijst.
Omdat er niemand reageert heb ik maar een poging gedaan.
Klik om te vergroten...

danny147 zei:
Beste HSV,

Ik ga deze afsluiten, want het lukt niet.
Grts Danny147
Klik om te vergroten...

danny147 zei:
Beste HSV,
Geen probleem als je het niet ziet zitten. :confused:
Vroeger was er nog een man of 5 à 6 die hun tanden hierin vastbijten, maar die tijd is blijkbaar gedaan.
HSV, Roncancio, Warme bakkertje, WIGI, enz...

Grts Danny147
Klik om te vergroten...

Mocht ik een keer in de buurt van je fabriek rijden neem ik aan dat ik wel een kopje koffie bij je kan scoren.
Maar voor nu een lekker biertje....proost.
 
Wat een mooi bericht... We zullen dit draadje nog gaan missen! :D
Wat mij betreft verdiend dit wel een leuk muziekje...
Proficiat jullie beiden met dit behaalde resultaat.
 
@ Harry

Er zijn niet voldoende superlativen om U te loven voor de manier waarop je je vastgebeten hebt in deze thread.
Een DIKKE, DIKKE, DIKKE pluim op uw hoed.

@ Danny

Vroeger was er nog een man of 5 à 6 die hun tanden hierin vastbijten, maar die tijd is blijkbaar gedaan.
HSV, Roncancio, Warme bakkertje, WIGI, enz...
Klik om te vergroten...

De dag dat mijn werkweek geen 90+ uren meer bedraagt zal ik mij met alle plezier terug vastbijten in uw mega kranendraadjes, maar voor nu hou ik het toch maar op de kortere meer simpele vragen.
 
Beste HSV en iedereen die een bijdrage heeft verleend.

Het is mooi geweest en weer een geslaagd resultaat.

Zoals mijn vorige grote projecten:

- Gegevens wegschrijven dmv lijst.
- Userform gebruiken in excel.
- Hijskabels vervangen !


Je weet dat ik in de toekomst met nog zo iets dergelijks gaat afkomen hé :p

Dan ga ik deze maar afsluiten bij 190 reacties :D

BEDANKT. :thumb:
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan