Új hozzászólás Aktív témák

• #20950 Delila_1 veterán #02644736 #20949

  Új Válasz 2014-03-16 10:28:54 #20950

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz #02644736 #20949 üzenetére

  Az A oszlop formátuma legyen Normál"/XY", a K-é pedig szöveg.

  A makróban az A oszlopba írandó adatot számként mentem (TextBox1*1), a többit szövegként. A textbox, mint a neve is mutatja, szöveges értéket ad alapból. Ha számként akarod menteni valamelyik adatot, szoroznod kell a felíráskor 1-gyel.

  10 db textboxba viszem be az adatokat a formon (A:J oszlop), a K oszlop adatát a TextBox1 értéke adja.

  Private Sub CommandButton1_Click()
  Dim sor As Long, usor As Long, kezd As Long, WF As WorksheetFunction, f As Boolean
  
  Set WF = Application.WorksheetFunction
  f = False
  Sheets("Munka1").Activate
  
  If WF.CountIf(Columns(1), TextBox1 * 1) > 0 Then
  kezd = WF.Match(TextBox1 * 1, Columns(1), 0) + 1
  usor = Range("A" & Rows.Count).End(xlUp).Row
  
  For sor = kezd To usor
  Cells(sor, "A") = Cells(sor, "A") + 1
  Cells(sor, "K") = Cells(sor, "A") & "/" & Year(Date)
  Next
  f = True
  Else
  usor = Range("A" & Rows.Count).End(xlUp).Row + 1
  End If
  
  'Adatbevitel a Munka1 lapra
  If f Then
  usor = usor + 1
  Range("A" & usor) = TextBox1 * 1 + 1
  Else
  Range("A" & usor) = TextBox1 * 1
  End If
  
  Range("B" & usor) = TextBox2
  Range("C" & usor) = TextBox3
  Range("D" & usor) = TextBox4
  Range("E" & usor) = TextBox5
  Range("F" & usor) = TextBox6
  Range("G" & usor) = TextBox7
  Range("H" & usor) = TextBox8
  Range("I" & usor) = TextBox9
  Range("J" & usor) = TextBox10
  
  If f Then
  Range("K" & usor) = TextBox1 + 1 & "/" & Year(Date)
  Else
  Range("K" & usor) = TextBox1 & "/" & Year(Date)
  End If
  
  'Rendezés
  usor = Range("A" & Rows.Count).End(xlUp).Row
  
  ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
  ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A" & usor), _
  SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveWorkbook.Worksheets("Munka1").Sort
  .SetRange Range("A1:K" & usor)
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
  End Sub

  Szerk.: beteheted a végére a textboxok kiürítését.

Új hozzászólás Aktív témák