waarde zoeken en daarmee rij aanpassen

Status
Niet open voor verdere reacties.
B

Bluestarrr

Gebruiker
Lid geworden
17 jul 2014
Berichten
6
Hallo iedereen,

Ik ben bezig met een excel document te maken, en ben bijna klaar! Alleen met deze macro blijf ik klooien en kom er niet meer uit. Ik hoop dat jullie mij
kunnen helpen. Hij is vrij groot... ala
Ik heb een invoerblad en een verzamelblad, men voert gegevens in op het invoerblad en klikken op de knop en dan moet alles worden gekopieerd
naar een andere sheet (prognose). Mijn code begint met een filter, die werkt perfect. Waarna de zoek functie begint, deze moet alleen mijn gefilterde rows
door spitten. (dit gaat mis, hij pakt alle rows...) Waarna als die de waarde vind, dan moet die de rij aanpassen door alle gegevens er in te kopieren. maar dat doet die ook
niet. En als die niet word gevonden (else functie) dan moet die een lege rij vinden en eveneens de gegevens er inplakken. Wederom zit er weer een klein foutje in deze lijnen,
want eerst werkte die wel. Ik hoop dat jullie mij verder kunnen helpen, met mijn 3 probleempjes!

Gr. Blue

Code: 
Sub Opslaan()
'Filteren van portfolio
Dim portfolio As String
portfolio = Worksheets("invoerdata").Range("D8")

With Worksheets("Prognose")
.AutoFilterMode = False
.Range("A1:A500").AutoFilter
.Range("A1:A500").AutoFilter Field:=1, Criteria1:=portfolio
End With

'zoek cel -> verander rij
Dim Naam As String
Naam = Worksheets("invoerdata").Range("D22")

row_number = 0
Do
DoEvents
row_number = row_number + 1
item_in_review = Worksheets("Prognose").Range("B" & row_number)
If item_in_review = Naam Then
Worksheets("invoerdata").Range("C" & row_number) = Worksheets("invoerdata").Range("D23").Value
Else
'Determine emptyrow
Dim emptyrow As Long
emptyrow = WorksheetFunction.CountA(Range("A:A")) + 1

'Data invoegen
Worksheets("Prognose").Cells(emptyrow, 1).Value = Worksheets("invoerdata").Range("D23").Value
Worksheets("Prognose").Cells(emptyrow, 2).Value = Worksheets("invoerdata").Range("D24").Value

'Make portfolio active
Worksheets("Invoerdata").Activate
End If

Loop Until item_in_review = ""


End Sub
 
Laatst bewerkt:
Zou je de code kunnen opmaken met de CODE knop? Die vind je als je op <Geavanceerd> klikt. Of, wat ik meestal doe, typ de tekst [ code] vóór de code, en [ /code] ná de code. Zonder de spatie achter de haak, want die staat daar omdat de tag anders niet te lezen is :).
 
Waarom eerst filteren alvorens de naam te beginnen zoeken ? Dit heeft toch geen enkele meerwaarde.
Een voorbeeldbestandje zou ook al kunnen helpen.
 
Laatst bewerkt:
Hoi warme bakkertje,

Ik heb onder dit bericht bestand toegevoegd hopelijk helpt dat. Ik doe eerst filter omdat ik met portfolio's werk, en asset. En in zoek functie zoek ik een asset, maar een asset naam kan dus in 2 portfolio tegen komen. En ik wil tijdens zoeken en aanpassen alleen de asset aanpassen in een specifiek portfolio en daarom filter ik eerst.

Bekijk bijlage helpmij.xlsmBekijk bijlage helpmij.xlsm
 
Ik zo weinig mogelijk aangepast aan jouw macro zodat je kan volgen.
Code: 
Sub Opslaan()
Dim portfolio As String, bFound As Boolean
Dim Naam As String, emptyrow As Long
portfolio = Worksheets("invoerdata").Range("D8")
Naam = Worksheets("invoerdata").Range("D22")
bFound = False: row_number = 0
Do
    DoEvents
    row_number = row_number + 1
    With Sheets("Prognose")
        item_in_review = .Range("B" & row_number)
        If item_in_review = Naam And .Range("A" & row_number) = portfolio Then
            .Range("C" & row_number) = Sheets("invoerdata").Range("D23").Value
            bFound = True
        Else
        End If
    End With
Loop Until item_in_review = ""
    If bFound = False Then
        With Sheets("Prognose")
            emptyrow = WorksheetFunction.CountA(.Range("A:A")) + 1
            .Cells(emptyrow, 1).Value = Sheets("invoerdata").Range("D23").Value
            .Cells(emptyrow, 2).Value = Sheets("invoerdata").Range("D24").Value
        End With
    End If
    'Worksheets("Invoerdata").Activate
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan