Nieuwe data toevoegen en bestaande data aanpassen (userform)

Status
Niet open voor verdere reacties.

GJ123

Gebruiker
Lid geworden
31 mei 2017
Berichten
13
Hi Allen,

Ik heb de volgende tabel:
Naamloos.jpg

Ik wil nu via een Userform de data kunnen aanpassen maar ook nieuwe airlines/airports/prijzen kunnen toevoegen.
Nieuwe data toevoegen werkt al redelijk, maar als ik nu bijvoorbeeld data wil aanpassen die al in de tabel staat kom ik niet verder dan:

Code:
If WorksheetFunction.CountIf(Blad1.Range("A2:A10"), Me.ComboBox1.Value) = 1 Then

Waarin ComboBox1 = Airline selectie

Hij moet dus wanneer de airline al in de lijst staat die rij in de tabel aanpassen.

Mochten jullie meer info nodig hebben hoor ik het graag!

Mvg,

GJ123
 
Laatst bewerkt:
Een voorbeeldbestand kan wel handig zijn, denk ik.
 
Code:
 Private Sub CommandButton1_Click()

Dim NextRow As Long

Sheets("Blad1").Activate

If WorksheetFunction.CountIf(Blad1.Range("A2:A10"), Me.ComboBox1.Value) = 1 Then


End If

NextRow = _
    Application.WorksheetFunction.CountA(Range("A1:A500")) + 1
     
Cells(NextRow, 1) = ComboBox1.Text
Cells(NextRow, 2) = TextBox2.Text
Cells(NextRow, 3) = TextBox4.Text
Cells(NextRow, 4) = TextBox5.Text
Cells(NextRow, 5) = TextBox6.Text
Cells(NextRow, 6) = TextBox7.Text
Cells(NextRow, 7) = TextBox8.Text
Cells(NextRow, 8) = TextBox9.Text
Cells(NextRow, 9) = TextBox10.Text
Cells(NextRow, 10) = TextBox11.Text
Cells(NextRow, 11) = TextBox12.Text


End Sub
Bekijk bijlage 300331
 
Laatst bewerkt:
Het bestand is niet te openen.

Code:
Private Sub CommandButton1_Click()
Dim r As Range, lr As Long
If ComboBox1.ListIndex = -1 Then Exit Sub
With Sheets("Blad1")
  Set r = .Columns(1).Find(ComboBox1.Value)
  If Not r Is Nothing Then lr = r.Row Else lr = .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
  .Cells(lr, 1).Resize(, 11) = Array(ComboBox1.value, TextBox1.value,...........,textbox12.value)
End With
End Sub
 
Bedankt voor je reactie, ik krijg nu de volgende foutmelding: (dik gedrukte deel)

Code:
Private Sub CommandButton1_Click()

Dim NextRow As Long

Sheets("Blad1").Activate

If WorksheetFunction.CountIf(Blad1.Range("A2:A10"), Me.ComboBox1.Value) = 1 Then
Dim r As Range, lr As Long
If ComboBox1.ListIndex = -1 Then Exit Sub
With Sheets("Blad1")
  Set r = .Columns(1).Find(ComboBox1.Value)
  If Not r Is Nothing Then lr = r.Row Else lr = .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
[B]  .Cells(lr, 1).Resize(, 11) = Array(ComboBox1.Value, TextBox1.Value, TextBox12.Value)[/B]
End With

End If

NextRow = _
    Application.WorksheetFunction.CountA(Range("A1:A500")) + 1
     
Cells(NextRow, 1) = ComboBox1.Text
Cells(NextRow, 2) = TextBox2.Text
Cells(NextRow, 3) = TextBox4.Text
Cells(NextRow, 4) = TextBox5.Text
Cells(NextRow, 5) = TextBox6.Text
Cells(NextRow, 6) = TextBox7.Text
Cells(NextRow, 7) = TextBox8.Text
Cells(NextRow, 8) = TextBox9.Text
Cells(NextRow, 9) = TextBox10.Text
Cells(NextRow, 10) = TextBox11.Text
Cells(NextRow, 11) = TextBox12.Text


End Sub
 
je moet natuurlijk wel alle 10 de textboxen in de array zetten. Je bijlage in #6 is ook niet te openen. (klik op ga geavanceerd en vervolgens op de paperclip)
 
Dankje, de bestaande data wijzigen lukt nu, alleen als ik nu een nieuwe airline toevoeg in de combobox komt hij niet in de eerst volgende lege rij. (bestand is nu ook geupload)

Code:
 Private Sub CommandButton1_Click()

Dim NextRow As Long

Sheets("Blad1").Activate

If WorksheetFunction.CountIf(Blad1.Range("A2:A10"), Me.ComboBox1.Value) = 1 Then
Dim r As Range, lr As Long
If ComboBox1.ListIndex = -1 Then Exit Sub
With Sheets("Blad1")
  Set r = .Columns(1).Find(ComboBox1.Value)
  If Not r Is Nothing Then lr = r.Row Else lr = .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
  .Cells(lr, 1).Resize(, 11) = Array(ComboBox1.Value, TextBox2.Value, TextBox4.Value, TextBox5.Value, TextBox6.Value, TextBox7.Value, TextBox8.Value, TextBox9.Value, TextBox10.Value, TextBox11.Value, TextBox12.Value)
End With

ElseIf ComboBox1.Value = 0 Then

NextRow = _
    Application.WorksheetFunction.CountA(Range("A1:A500")) + 1
    
Cells(NextRow, 1) = ComboBox1.Text


End If
Bekijk bijlage TEST.xlsm
 
Dan moet je deze regel weghalen

Code:
If ComboBox1.ListIndex = -1 Then Exit Sub

En ook jouw oude code.

Code:
Private Sub CommandButton1_Click()
Dim r As Range, lr As Long
With Sheets("Blad1")
  Set r = .Columns(1).Find(ComboBox1.Value)
  If Not r Is Nothing Then lr = r.Row Else lr = .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
  .Cells(lr, 1).Resize(, 11) = Array(ComboBox1.Value, TextBox2.Value, TextBox4.Value, TextBox5.Value, TextBox6.Value, TextBox7.Value, TextBox8.Value, TextBox9.Value, TextBox10.Value, TextBox11.Value, TextBox12.Value)
End With
End Sub
 
klopt hij werkt nu!

Nu nog 1 ding: als ik nou een nieuwe bestemming wil toevoegen dus op rij 1. Wat is hiervoor de code?
 
Ik kan niet echt een beeld vormen van wat de bedoeling is.
Net als bij een rows.count kan je ook een Columns.Count gebruiken.
Code:
Cells(1, Columns.Count).End(xlToLeft).Offset(, 1) = "Nieuwe bestemming"
 
Ik zal het even uitleggen aan de hand van de bijgevoegde afbeelding:
Eigenlijk zijn er 3 invoervakken in het userform
"Airline"
"Destination"
"Bedrag" --> kleine vakje

Wanneer je in het userform een bestaande airline en destination aangeeft, moet hij dus het bedrag wijzigen in de bestaande tabel.
Wanneer je een nieuwe airline en/of destination invult moet die dus toegevoegd worden aan de tabel met het bedrag.

Excuus voor de onduidelijkheid, hoop dat het zo duidelijk is!Naamloos2.jpg
 
Het mag toch duidelijk zijn dat een plaatje geen enkele toegevoegde waarde heeft. Van 11 naar 3 en een ieder die je wil helpen mag gokken waar wat moet komen? Dus eerst even nadenken over wat je wil en dan een goed voorbeeld plaatsen met een duidelijke uitleg lijkt mij een betere start.
 
Oke ik ga m'n best doen het zo duidelijk mogelijk uit te leggen.

Via het userform zijn er 3 keuzes:
1) Airline (kolom A) --> ComboBox1
2) Destination (Rij 1) --> ComboBox2
3) Prijs (B2:K10) --> TextBox1

De tabel is al gevuld (zie afbeelding). Deze gegevens moeten wel gewijzigd kunnen worden via het userform. Maar wanneer de gebruiker een niet bestaande airline of destination invuld moet deze toegevoegd aan de tabel. Dus een nieuwe airline moet in de firstrow erbij komen en een nieuwe destination in de eerste kolom.
Tabel.jpg


Voorbeeld 1:
Gebruiker kiest voor "Airline KLM" en "destination China" en vult dus het bedrag in in TextBox1. Dan moet cell D4 worden gewijzigd.

Voorbeeld 2:
Gebruiker kiest een niet bestaande airline en een niet bestaande destination. Dan moet er een nieuwe rij worden gecreëerd op rij 11 en een nieuwe kolom "J".

Bijgevoegd het bestand en de afbeelding.

Bvd!

Bekijk bijlage TEST.xlsm
 
Je spreekt je zelf tegen.
Dus een nieuwe airline moet in de firstrow erbij komen en een nieuwe destination in de eerste kolom.
Dan moet er een nieuwe rij worden gecreëerd op rij 11 en een nieuwe kolom "J".

Obv de eerste rij en de eerste kolom. En anders moet je het even aanpassen. De gegevens heb ik in een tabel gezet.
Code:
Private Sub CommandButton1_Click()
Dim r As Range, c As Range, lr As Long, lc As Long
  With Sheets("Blad1").ListObjects(1)
    Set r = .DataBodyRange.Columns(1).Find(ComboBox1.Value)
    Set c = .HeaderRowRange.Find(ComboBox2.Value)
    If Not r Is Nothing Then
      lr = r.Row
    Else
      lr = 2
      .ListRows.Add (1)
      .Range.Cells(2, 1) = ComboBox1.Value
      ComboBox1.List = .DataBodyRange.Columns(1).Value
    End If
    If Not c Is Nothing Then
      lc = c.Column
     Else
      lc = 2
      .ListColumns.Add (2)
      .HeaderRowRange.Columns(2) = ComboBox2.Value
      ComboBox2.List = Application.Transpose(.HeaderRowRange.Offset(, 1).SpecialCells(2).Value)
    End If
    .Range.Cells(lr, lc) = TextBox1.Value
    .Range.Columns.AutoFit
    With .DataBodyRange.Offset(, 1)
      .NumberFormat = "$ #,##0.00"
      .Font.Bold = False
    End With
  End With
End Sub

Comboboxen en listboxen vul je zo
Code:
Private Sub UserForm_Initialize()
  With Sheets("Blad1").ListObjects(1)
    ComboBox1.List = .DataBodyRange.Columns(1).Value
    ComboBox2.List = Application.Transpose(.HeaderRowRange.Offset(, 1).SpecialCells(2).Value)
  End With
End Sub
 

Bijlagen

  • TEST-1.xlsb
    33,3 KB · Weergaven: 67
Laatst bewerkt:
Excuus voor m'n laatste reactie.

Ik bedoel dat een nieuwe airline dus in de eerste beschikbare row moet komen onder de tabel. En de bestemming dan in de eerst beschikbare kolom.
De tabel moet dus worden uitgebreid, samen met het tarief dat er bij wordt ingevoerd in de TextBox.

Bij bestaande combinatie airline/bestemming moet het tarief wat al in de tabel staat aangepast worden.

Helaas krijg ik een een foutmelding bij:
Code:
 With Sheets("Blad1").ListObjects(1)
"het subscript valt buiten het bereik"

en bij

Code:
  Set r = .DataBodyRange.Columns(1).Find(ComboBox1.Value)
"Deze eigenschap of methode wordt niet ondersteund door dit object"

Ik hoor graag van je!
 
Laatst bewerkt:
In welk bestand krijg je de melding? Heb je er wel een tabel van gemaakt? Voor zowel de eerst beschikbare row als de eerst beschikbare column heb je de code al en kan je dus zelf prima aanpassen. Dat het binnen een tabel (listobject) net iets anders werkt geeft dan gelijk een mooi leer- zoekmoment.

Waarvoor alphamax je net een paar linkjes heeft gegeven:thumb:
 
Als ik nu jouw bestand gebruik, krijg ik een foutmelding bij het volgende deel (dikgedrukt)

Excuus maar ik ben niet zo ver gevorderd :(

Code:
 Sub Knop1_Klikken()
'
' Knop1_Klikken Macro
'

'
    Range("N15:O15").Select
    ActiveWorkbook.Save
    Range("E18").Select
    Sheets("Airline Information").Select
    Range("C15").Select
    Sheets("Blad1").Select
    ActiveWorkbook.Save
    Sheets("Blad2").Select
    Range("P6:P7").Select
    ActiveWindow.SmallScroll Down:=-12
    Sheets("Blad1").Select
    Range("K14").Select
    Sheets("Demand").Select
    ActiveWindow.SmallScroll Down:=-21
    Sheets("Demand").Select
    Range("C16").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-1]*10)"
    Range("C13").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-1]*10)"
    Range("C19").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-1]*10)"
    Range("H14").Select
    ActiveWorkbook.Save
    ActiveWorkbook.Save
    Sheets("Airline Information").Select
    Range("C20").Select
    Sheets("Blad1").Select
    Range("M16").Select
    ActiveWorkbook.Save
    ActiveWorkbook.Save
    Application.WindowState = xlNormal
    ActiveWindow.SmallScroll Down:=-18
    Range("B2").Select
    Application.WindowState = xlNormal
    Range("B4:I12").Select
    Selection.Copy
    [B]Windows("TEST.xlsm").Activate[/B]
    Range("B2").Select
    ActiveSheet.Paste
    Range("F18").Select
    Windows("MS4 opdracht.xlsx").Activate
    ActiveWindow.Close
    Application.Left = 211.75
    Application.Top = 45.25
    ActiveWorkbook.Save
    Application.WindowState = xlMaximized
    Sheets("Blad1").Select
    ActiveSheet.Shapes.Range(Array("Button 1")).Select
    Selection.Delete
    Selection.Cut
    Range("P11").Select
    ActiveWorkbook.Save
    Range("E19").Select
    ActiveWorkbook.Save
    ActiveWindow.SmallScroll Down:=-6
    Range("F15").Select
    ActiveWorkbook.Save
    Application.WindowState = xlNormal
    ActiveWorkbook.RunAutoMacros Which:=xlAutoClose
End Sub

Private Sub CommandButton1_Click()
Dim r As Range, c As Range, lr As Long, lc As Long
  With Sheets("Blad1").ListObjects(1)
    Set r = .DataBodyRange.Columns(1).Find(ComboBox1.Value)
    Set c = .HeaderRowRange.Find(ComboBox2.Value)
    If Not r Is Nothing Then
      lr = r.Row
    Else
      lr = 2
      .ListRows.Add (1)
      .Range.Cells(2, 1) = ComboBox1.Value
      ComboBox1.List = .DataBodyRange.Columns(1).Value
    End If
    If Not c Is Nothing Then
      lc = c.Column
     Else
      lc = 2
      .ListColumns.Add (2)
      .HeaderRowRange.Columns(2) = ComboBox2.Value
      ComboBox2.List = Application.Transpose(.HeaderRowRange.Offset(, 1).SpecialCells(2).Value)
    End If
    .Range.Cells(lr, lc) = TextBox1.Value
    .Range.Columns.AutoFit
    With .DataBodyRange.Offset(, 1)
      .NumberFormat = "$ #,##0.00"
      .Font.Bold = False
    End With
  End With
End Sub

Private Sub UserForm_Initialize()
  With Sheets("Blad1").ListObjects(1)
    ComboBox1.List = .DataBodyRange.Columns(1).Value
    ComboBox2.List = Application.Transpose(.HeaderRowRange.Offset(, 1).SpecialCells(2).Value)
  End With
End Sub
 
Een dataform neemt je al het werk uit handen.
Waarom zelf iets maken (met het risico dat het niet goed werkt), terwijl er in excel als iets zit wat gemaakt is door de programmeurs van microsoft.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan