Страницы: 1
RSS
Перезапись строки через Userform при повторении занчений
 
Добрый день.
Суть такая: есть файл, через форму вносятся данные которые падают в таблицу на скрытом листе, запись идет по первой пустой ячейке
Код
Dim A           As Long

With Sheets("Данные")
    A = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    
    .Cells(A, 1).Value = TextBox17.Value
    
    .Cells(A, 3).Value = ComboBox1.Value

End With

TextBox17.Value = ""
   
    ComboBox1.Value = ""

Далее со скрытого листа все тянется на доступный для пользователя лист)

Может возникнуть такая ситуация, что внесут повторно Дата и Смена при этом все запишется в новую строку и данные задвоятся.

Как сделать перезапись данных если пользователь вводит существующие данные в таблице по 2 параметрам Дата+Смена

пример файлика не лезет((

Пример за двоения на картинке

Изменено: Scarinta - 07.02.2025 11:07:16
Экономьте электричество!
Отключите NumLock!
 
Код
    With Sheets("Данные")
        If WorksheetFunction.CountIfs(.Columns(1), TextBox17.Value, .Columns(3), ComboBox1.Value) = 0 Then
            A = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Cells(A, 1).Value = TextBox17.Value
            .Cells(A, 3).Value = ComboBox1.Value
        End If
    End With
 
Здравствуйте! Попробуйте как то так:
Код
Dim ws As Worksheet
Dim lastRow As Long
Dim foundRow As Long
Dim i As Long

Set ws = Sheets("Данные")

lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

foundRow = 0

' Поиск совпадения по "Дате" и "Смене"
For i = 1 To lastRow
    If ws.Cells(i, 1).Value = TextBox17.Value And _
       ws.Cells(i, 3).Value = ComboBox1.Value Then
        foundRow = i
        Exit For
    End If
Next i

If foundRow > 0 Then
    With ws
        .Cells(foundRow, 1).Value = TextBox17.Value 
        .Cells(foundRow, 3).Value = ComboBox1.Value 
    End With
Else
    lastRow = lastRow + 1
    With ws
        .Cells(lastRow, 1).Value = TextBox17.Value
        .Cells(lastRow, 3).Value = ComboBox1.Value 
    End With
End If
 
del
Изменено: asesja - 07.02.2025 12:13:25
 
МатросНаЗебре, нужна перезапись в любом случае как я понял. У Вас проверка, что если нет то записываем.
 
Сомнительно, но окЭй. Есть ли смысл записывать в ячейки, где эти значения уже есть?
 
По скрину видно, что там запись не только этих значений идет
 
окЭй
 
Nikita N, почему то не работает((
все равно пишет в новую строку
Экономьте электричество!
Отключите NumLock!
 
Код
       Dim arr As Variant
        arr = .Cells(1, 1).Resize(.UsedRange.Rows.Count, 3).Value
        For A = 1 To UBound(arr, 1)
            If (CStr(arr(A, 1)) = TextBox17.Value _
            And CStr(arr(A, 3)) = ComboBox1.Value) _
            Or IsEmpty(arr(A, 1)) Then Exit For
        Next
        If IsEmpty(.Cells(A, 1).Value) Then .Cells(A, 1).Resize(, 3).FormulaR1C1 = Array(TextBox17.Value, .Cells(A, 2).FormulaR1C1, ComboBox1.Value)
Изменено: МатросНаЗебре - 07.02.2025 12:52:23 (If IsEmpty(.Cells(A, 1).Value) Then)
 
Код
Private Sub CommandButton1_Click()

Dim ws As Worksheet
Dim lastRow As Long
Dim foundRow As Long
Dim i As Long

Set ws = Sheets("Äàííûå")

lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

foundRow = 0

' Ïîèñê ñîâïàäåíèÿ ïî "Äàòå" è "Ñìåíå"
For i = 1 To lastRow
    If ws.Cells(i, 1).Value = TextBox17.Value And _
       UCase(Trim(ws.Cells(i, 4).Value)) = UCase(Trim(ComboBox3.Value)) Then
        foundRow = i
        Exit For
    End If
Next i

If foundRow > 0 Then
    With ws
        .Cells(foundRow, 1).Value = TextBox17.Value
        .Cells(foundRow, 3).Value = ComboBox1.Value
        .Cells(foundRow, 4).Value = ComboBox3.Value
        .Cells(foundRow, 5).Value = TB_Personal.Value
        .Cells(foundRow, 6).Value = TB_Personal_h.Value
        .Cells(foundRow, 7).Value = TB_AY.Value
        .Cells(foundRow, 8).Value = TB_AY_h.Value
        .Cells(foundRow, 10).Value = TB_Auto.Value
        .Cells(foundRow, 9).Value = TB_Zakaz.Value
        .Cells(foundRow, 11).Value = TB_Poz.Value
        .Cells(foundRow, 12).Value = TB_Ves.Value
        .Cells(foundRow, 13).Value = TB_OFO.Value
        .Cells(foundRow, 14).Value = TB_Pret.Value
        .Cells(foundRow, 15).Value = TB_Problem_Pers.Value
        .Cells(foundRow, 16).Value = TB_Problem_IT.Value
        .Cells(foundRow, 17).Value = TB_Problem_dr.Value
       
         Îò÷åò.Hide
    End With
    
Else
    lastRow = lastRow + 1
    With ws
        .Cells(lastRow, 1).Value = TextBox17.Value
        .Cells(lastRow, 3).Value = ComboBox1.Value
        .Cells(lastRow, 4).Value = ComboBox3.Value
        .Cells(lastRow, 5).Value = TB_Personal.Value
        .Cells(lastRow, 6).Value = TB_Personal_h.Value
        .Cells(lastRow, 7).Value = TB_AY.Value
        .Cells(lastRow, 8).Value = TB_AY_h.Value
        .Cells(lastRow, 10).Value = TB_Auto.Value
        .Cells(lastRow, 9).Value = TB_Zakaz.Value
        .Cells(lastRow, 11).Value = TB_Poz.Value
        .Cells(lastRow, 12).Value = TB_Ves.Value
        .Cells(lastRow, 13).Value = TB_OFO.Value
        .Cells(lastRow, 14).Value = TB_Pret.Value
        .Cells(lastRow, 15).Value = TB_Problem_Pers.Value
        .Cells(lastRow, 16).Value = TB_Problem_IT.Value
        .Cells(lastRow, 17).Value = TB_Problem_dr.Value
         Îò÷åò.Hide
     End With
     
    End If
    Unload Me
    

End Sub


вот так вроде работает
Экономьте электричество!
Отключите NumLock!
 
Вместо это
Код
        .Cells(foundRow, 1).Value = TextBox17.Value
        .Cells(foundRow, 3).Value = ComboBox1.Value
        .Cells(foundRow, 4).Value = ComboBox3.Value
        .Cells(foundRow, 5).Value = TB_Personal.Value
        .Cells(foundRow, 6).Value = TB_Personal_h.Value
        .Cells(foundRow, 7).Value = TB_AY.Value
        .Cells(foundRow, 8).Value = TB_AY_h.Value
        .Cells(foundRow, 10).Value = TB_Auto.Value
        .Cells(foundRow, 9).Value = TB_Zakaz.Value
        .Cells(foundRow, 11).Value = TB_Poz.Value
        .Cells(foundRow, 12).Value = TB_Ves.Value
        .Cells(foundRow, 13).Value = TB_OFO.Value
        .Cells(foundRow, 14).Value = TB_Pret.Value
        .Cells(foundRow, 15).Value = TB_Problem_Pers.Value
        .Cells(foundRow, 16).Value = TB_Problem_IT.Value
        .Cells(foundRow, 17).Value = TB_Problem_dr.Value
лучше написать так.
Код
        .Cells(foundRow, 1).Resize(, 17).Value = _
            Array(TextBox17.Value, _
            .Cells(foundRow, 2).Value, _
            ComboBox1.Value, _
            ComboBox3.Value, _
            TB_Personal.Value, _
            TB_Personal_h.Value, _
            TB_AY.Value, _
            TB_AY_h.Value, _
            TB_Auto.Value, _
            TB_Zakaz.Value, _
            TB_Poz.Value, _
            TB_Ves.Value, _
            TB_OFO.Value, _
            TB_Pret.Value, _
            TB_Problem_Pers.Value, _
            TB_Problem_IT.Value, _
            TB_Problem_dr.Value)
В этом случае происходит 1 вывод на лист вместо 16.
 
И в сообщении #11 вы написали 2 одинаковых блока для foundRow и lastRow. Если появится тяга к рефакторингу, то эти два блока надо свести к одному. Пример можно посмотреть в сообщении #10.
Страницы: 1
Наверх