Solved Increment a value (1 Viewer)

G

goncalo

Member
Local time
Today, 11:30
Joined
May 23, 2023
Messages
51
Hello everyone
I have this code right here and i want to add another something else to it but i have no clue how to


Code: 
Private Sub CommandButton1_Click()
    Dim repeticoes As Integer
    repeticoes = Me.ComboBox1.value

    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim cavidadeValue As String
    Dim targetWorkbook As Workbook
    Dim targetCell As Range
    Dim tipoDePecaComboBox As Object
    Dim tipoDeProblemaComboBox As Object
    Dim cavidadesComboBox As Object
    Dim semanaComboBox As Object
    Dim anoComboBox As Object
    Dim tipoAnaliseBox As Object
    Dim problemaBox1 As Object

    ' Definição do sheet source (Sheet1) e do target (Dados)
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Set targetWorkbook = Workbooks.Open("W:\Quality\70. Leaks\Leak Files\Teardown YF\YF\teste\dados.xlsm")
    Set targetSheet = targetWorkbook.Sheets("Dados")
    Set tipoAnaliseBox = sourceSheet.OLEObjects("tipoanaliseBox").Object
    Set problemaBox1 = sourceSheet.OLEObjects("problemaComboBox").Object

    Dim i As Integer
    For i = 1 To repeticoes
        Select Case True
            '----------------------------------------------------------3/4------------------------------------------------------------------
            Case tipoAnaliseBox = "3/4"
            

                sourceSheet.Unprotect password:="567"

                ' Encontra a próxima linha disponível começando na segunda linha da coluna B no targetSheet
                lastRow = targetSheet.Cells(targetSheet.Rows.Count, 3).End(xlUp).row + 1

                ' A linha abaixo vai buscar o valor do cavidadeBox e transfere-o em formato de texto
                ' É necessário fazer isto pois como certas cavidades têm o formato de x/x/x, o Excel assume que as cavidades
                ' deviam estar em formato de data, e nós não queremos isso.
                cavidadeValue = sourceSheet.OLEObjects("cavidadeBox").Object.Text

                ' Transferência dos valores do sourceSheet para o targetSheet no arquivo de destino
                targetSheet.Cells(lastRow, "B").NumberFormat = "@"
                targetSheet.Cells(lastRow, "B").value = sourceSheet.OLEObjects("tipoAnaliseBox").Object.value
                targetSheet.Cells(lastRow, "F").value = sourceSheet.Range("R14").value
                targetSheet.Cells(lastRow, "C").NumberFormat = "@"
                targetSheet.Cells(lastRow, "C").value = sourceSheet.OLEObjects("genComboBox").Object.value
                targetSheet.Cells(lastRow, "D").value = sourceSheet.OLEObjects("modelComboBox").Object.value
                targetSheet.Cells(lastRow, "E").value = sourceSheet.OLEObjects("pecaComboBox").Object.value
                If sourceSheet.Range("E21").value = "" Then
                    targetSheet.Cells(lastRow, "H").value = sourceSheet.OLEObjects("semanaBox").Object.value & "-" & sourceSheet.OLEObjects("anoBox").Object.value
                Else
                    targetSheet.Cells(lastRow, "H").value = sourceSheet.Range("E21").value
                End If
                targetSheet.Cells(lastRow, "G").value = sourceSheet.Range("K14").value
                targetSheet.Cells(lastRow, "I").NumberFormat = "@" ' Formatação do valor das cavidades como texto
                targetSheet.Cells(lastRow, "I").value = cavidadeValue
                targetSheet.Cells(lastRow, "J").value = sourceSheet.Range("L19").value
                targetSheet.Cells(lastRow, "K").value = sourceSheet.OLEObjects("problemaComboBox").Object.value
                targetSheet.Cells(lastRow, "L").NumberFormat = "@"
                targetSheet.Cells(lastRow, "L").value = sourceSheet.Range("N19").value
                targetSheet.Cells(lastRow, "M").value = sourceSheet.OLEObjects("tipoamostraBox").Object.value
                targetSheet.Cells(lastRow, "N").value = sourceSheet.OLEObjects("turnoBox").Object.value
                targetSheet.Cells(lastRow, "O").value = sourceSheet.OLEObjects("comboBoxanalisador").Object.value
                targetSheet.Cells(lastRow, "P").NumberFormat = "@"
                targetSheet.Cells(lastRow, "P").value = sourceSheet.Range("O12").value
                targetSheet.Cells(lastRow, "Q").NumberFormat = "@"
                targetSheet.Cells(lastRow, "Q").value = sourceSheet.Range("S19").value

                ' Salva o arquivo de destino
                targetWorkbook.Save

            '----------------------------------------------------------Fixture------------------------------------------------------------------
            Case tipoAnaliseBox = "Fixture"
          

                sourceSheet.Unprotect password:="567"

                ' Encontra a próxima linha disponível começando na segunda linha da coluna B no targetSheet
                lastRow = targetSheet.Cells(targetSheet.Rows.Count, 3).End(xlUp).row + 1

                ' A linha abaixo vai buscar o valor do cavidadeBox e transfere-o em formato de texto
                ' É necessário fazer isto pois como certas cavidades têm o formato de x/x/x, o Excel assume que as cavidades
                ' deviam estar em formato de data, e nós não queremos isso.
                cavidadeValue = sourceSheet.OLEObjects("cavidadeBox").Object.Text

                ' Transferência dos valores do sourceSheet para o targetSheet no arquivo de destino
                targetSheet.Cells(lastRow, "B").NumberFormat = "@"
                targetSheet.Cells(lastRow, "B").value = sourceSheet.OLEObjects("tipoAnaliseBox").Object.value
                targetSheet.Cells(lastRow, "F").value = sourceSheet.Range("R14").value
                targetSheet.Cells(lastRow, "C").NumberFormat = "@"
                targetSheet.Cells(lastRow, "C").value = sourceSheet.OLEObjects("genComboBox").Object.value
                targetSheet.Cells(lastRow, "D").value = sourceSheet.OLEObjects("modelComboBox").Object.value
                targetSheet.Cells(lastRow, "E").value = sourceSheet.OLEObjects("pecaComboBox").Object.value
                If sourceSheet.Range("E21").value = "" Then
                    targetSheet.Cells(lastRow, "H").value = sourceSheet.OLEObjects("semanaBox").Object.value & "-" & sourceSheet.OLEObjects("anoBox").Object.value
                Else
                    targetSheet.Cells(lastRow, "H").value = sourceSheet.Range("E21").value
                End If
                targetSheet.Cells(lastRow, "G").value = sourceSheet.Range("K14").value
                targetSheet.Cells(lastRow, "I").NumberFormat = "@" ' Formatação do valor das cavidades como texto
                targetSheet.Cells(lastRow, "I").value = cavidadeValue
                targetSheet.Cells(lastRow, "J").value = sourceSheet.Range("L19").value
                targetSheet.Cells(lastRow, "K").value = sourceSheet.OLEObjects("problemaComboBox").Object.value
                targetSheet.Cells(lastRow, "L").NumberFormat = "@"
                targetSheet.Cells(lastRow, "L").value = sourceSheet.Range("N19").value
                targetSheet.Cells(lastRow, "M").value = sourceSheet.OLEObjects("tipoamostraBox").Object.value
                targetSheet.Cells(lastRow, "N").value = sourceSheet.OLEObjects("turnoBox").Object.value
                targetSheet.Cells(lastRow, "O").value = sourceSheet.OLEObjects("comboBoxanalisador").Object.value
                targetSheet.Cells(lastRow, "P").NumberFormat = "@"
                targetSheet.Cells(lastRow, "P").value = sourceSheet.Range("O12").value
                targetSheet.Cells(lastRow, "Q").NumberFormat = "@"
                targetSheet.Cells(lastRow, "Q").value = sourceSheet.Range("S19").value

                ' Salva o arquivo de destino
                targetWorkbook.Save
        End Select
    Next i

    ' Fecha o arquivo de destino sem exibição
    targetWorkbook.Close SaveChanges:=False

    ' Exibe uma mensagem de sucesso ao usuário
    MsgBox "Valores transferidos com sucesso!", vbInformation, "Sucesso"

    ' Fecha a janela do formulário
    Unload Me
End Sub

Basically i want to increment the value in cell N19 of my sourcesheet when this value gets sent over to column L of dados.xlsm
let's say i write the following in cell N19 "A120" and choose 4 repetitions
I want the following numbers to be seen in column L of dados : "A120" and then "A121" (in the cell below) ,"A122" (in the cell below), "A123" (in the cell below), "A124" (in the cell below)

basically i want to increment it the same amount of times as there is repetitions

The types of values cell N19 will be receiving are always something along the lines of "C251"
Oh and i would also like to make it so that if the user writes something like "D999" and chooses 2 or more repetitions the values will be sent like "D999","D1","D2"... (Basically 999 is the max number)

If you need more info or a better explanation ill try my best to give it to you

Thank you for reading!
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 11:30
Joined
Sep 21, 2011
Messages
14,301
Firstly I would get rid of all the duplicated code. You appear to be doing much the same regardless of case value.
Then use your repeticoes number to calculate what the L value should be.

So on 1 it will be the N19 Cell value (as you have now)
Anything else it will be Left(Cell,1) & Val(Mid(Cell,2)+i

Then walk through your code inspecting the values.
 
G

goncalo

Member
Local time
Today, 11:30
Joined
May 23, 2023
Messages
51
Thanks Gasman!
i managed to fix it and i went with the following code

Code: 
Private Sub CommandButton1_Click()
Dim sourceSheet As Worksheet
Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Dim repeticoes As Long, seq As Collection, lastRow As Range
    repeticoes = Me.ComboBox1.value
    Set seq = Sequence(sourceSheet.Range("N19").value, repeticoes)
    
    Dim targetSheet As Worksheet
    Dim cavidadeValue As String
    Dim targetWorkbook As Workbook
    Dim targetCell As Range
    Dim tipoDePecaComboBox As Object
    Dim tipoDeProblemaComboBox As Object
    Dim cavidadesComboBox As Object
    Dim semanaComboBox As Object
    Dim anoComboBox As Object
    Dim tipoAnaliseBox As Object
    Dim problemaBox1 As Object

    ' Definição do sheet source (Sheet1) e do target (Dados)
    
    Set targetWorkbook = Workbooks.Open("W:\Quality\70. Leaks\Leak Files\Teardown YF\YF\teste\1.xlsx")
    Set targetSheet = targetWorkbook.Sheets("Folha1")
    Set tipoAnaliseBox = sourceSheet.OLEObjects("tipoanaliseBox").Object
    Set problemaBox1 = sourceSheet.OLEObjects("problemaComboBox").Object

    Dim i As Integer
    For i = 1 To seq.Count
        Select Case True
            '----------------------------------------------------------3/4------------------------------------------------------------------
            Case tipoAnaliseBox = "3/4"
                ' Verifica se algum campo obrigatório está em branco
                If sourceSheet.OLEObjects("genComboBox").Object.value = "" Or _
                    tipoAnaliseBox.value = "" Or _
                    sourceSheet.OLEObjects("modelComboBox").Object.value = "" Or _
                    sourceSheet.OLEObjects("pecaComboBox").Object.value = "" Or _
                    sourceSheet.OLEObjects("tipoamostraBox").Object.value = "" Or _
                    sourceSheet.OLEObjects("turnoBox").Object.value = "" Or _
                    sourceSheet.OLEObjects("comboBoxanalisador").Object.value = "" Or _
                    sourceSheet.OLEObjects("cavidadeBox").Object.Text = "" Or _
                    problemaBox1.Text = "" Or _
                    sourceSheet.Range("R14").value = "" Or _
                    sourceSheet.Range("K14").value = "" Or _
                    sourceSheet.Range("O12").value = "" Or _
                    sourceSheet.Range("L19").value = "" Then
                    ' Exibe a mensagem de erro ao utilizador caso algum campo necessário não tenha sido preenchido
                    MsgBox "Preencha todos os campos necessários!", vbExclamation, "Erro: falta de informação necessária"
                    Exit Sub ' Sai do procedimento caso algum campo ainda estiver em branco
                End If

                ' Mensagem de erro caso o utilizador tenha preenchido a data de produção da peça e a caixa da semana e do ano
                If (sourceSheet.Range("E21").value <> "" And (sourceSheet.OLEObjects("semanaBox").Object.value <> "" Or sourceSheet.OLEObjects("anoBox").Object.value <> "")) Then
                    MsgBox "Preencha apenas a data de produção da peça ou a semana e o ano", vbExclamation, "Erro: conflito de informação"
                    Exit Sub
                End If

                ' Mensagem de erro caso o utilizador tenha definido a data de produção da peça numa data depois da data de produção e da data de análise
                If sourceSheet.Range("E21").value > sourceSheet.Range("K14").value And sourceSheet.Range("R14").value Then
                    MsgBox "A data de produção da peça não pode ser depois da data de análise e da data de produção.", vbExclamation, "Erro: Data inválida"
                    Exit Sub
                End If

                ' Mensagem de erro caso o utilizador tenha escolhido uma data de produção que seja depois da data da análise
                If sourceSheet.Range("K14").value > sourceSheet.Range("R14").value Then
                    MsgBox "A data de produção não pode ser depois da data de análise.", vbExclamation, "Erro: Data inválida"
                    Exit Sub
                End If

                sourceSheet.Unprotect password:="567"

            '----------------------------------------------------------Fixture------------------------------------------------------------------
            Case tipoAnaliseBox = "Fixture"
                ' Verifica se algum campo obrigatório está em branco
                If sourceSheet.OLEObjects("genComboBox").Object.value = "" Or _
                    tipoAnaliseBox.value = "" Or _
                    sourceSheet.OLEObjects("modelComboBox").Object.value = "" Or _
                    sourceSheet.OLEObjects("pecaComboBox").Object.value = "" Or _
                    sourceSheet.OLEObjects("tipoamostraBox").Object.value = "" Or _
                    sourceSheet.OLEObjects("turnoBox").Object.value = "" Or _
                    sourceSheet.OLEObjects("comboBoxanalisador").Object.value = "" Or _
                    problemaBox1.Text = "" Or _
                    sourceSheet.Range("R14").value = "" Or _
                    sourceSheet.Range("K14").value = "" Or _
                    sourceSheet.Range("N19").value = "" Then
                    
                    ' Exibe a mensagem de erro ao utilizador caso algum campo necessário não tenha sido preenchido
                    MsgBox "Preencha todos os campos necessários!", vbExclamation, "Erro: falta de informação necessária"
                    Exit Sub ' Sai do procedimento caso algum campo ainda estiver em branco
                End If

                ' Mensagem de erro caso o utilizador tenha preenchido a data de produção da peça e a caixa da semana e do ano
                If (sourceSheet.Range("E21").value <> "" And (sourceSheet.OLEObjects("semanaBox").Object.value <> "" Or sourceSheet.OLEObjects("anoBox").Object.value <> "")) Then
                    MsgBox "Preencha apenas a data de produção da peça ou a semana e o ano", vbExclamation, "Erro: conflito de informação"
                    Exit Sub
                End If

                ' Mensagem de erro caso o utilizador tenha definido a data de produção da peça numa data depois da data de produção e da data de análise
                If sourceSheet.Range("E21").value > sourceSheet.Range("K14").value And sourceSheet.Range("R14").value Then
                    MsgBox "A data de produção da peça não pode ser depois da data de análise e da data de produção.", vbExclamation, "Erro: Data inválida"
                    Exit Sub
                End If

                ' Mensagem de erro caso o utilizador tenha escolhido uma data de produção que seja depois da data da análise
                If sourceSheet.Range("K14").value > sourceSheet.Range("R14").value Then
                    MsgBox "A data de produção não pode ser depois da data de análise.", vbExclamation, "Erro: Data inválida"
                    Exit Sub
                End If

                sourceSheet.Unprotect password:="567"

        End Select
        
                ' Encontra a próxima linha disponível começando na segunda linha da coluna B no targetSheet
                Set lastRow = targetSheet.Cells(targetSheet.Rows.Count, 3).End(xlUp).Offset(1).EntireRow

                ' A linha abaixo vai buscar o valor do cavidadeBox e transfere-o em formato de texto
                ' É necessário fazer isto pois como certas cavidades têm o formato de x/x/x, o Excel assume que as cavidades
                ' deviam estar em formato de data, e nós não queremos isso.
                cavidadeValue = sourceSheet.OLEObjects("cavidadeBox").Object.Text

                ' Transferência dos valores do sourceSheet para o targetSheet no arquivo de destino
                lastRow.Columns("B").NumberFormat = "@"
                lastRow.Columns("B").value = tipoAnaliseBox.value
                lastRow.Columns("F").value = sourceSheet.Range("R14").value
                lastRow.Columns("C").NumberFormat = "@"
                lastRow.Columns("C").value = sourceSheet.OLEObjects("genComboBox").Object.value
                lastRow.Columns("D").value = sourceSheet.OLEObjects("modelComboBox").Object.value
                lastRow.Columns("E").value = sourceSheet.OLEObjects("pecaComboBox").Object.value
                If sourceSheet.Range("E21").value = "" Then
                    lastRow.Columns("H").value = sourceSheet.OLEObjects("semanaBox").Object.value & "-" & sourceSheet.OLEObjects("anoBox").Object.value
                Else
                    lastRow.Columns("H").value = sourceSheet.Range("E21").value
                End If
                lastRow.Columns("G").value = sourceSheet.Range("K14").value
                lastRow.Columns("I").NumberFormat = "@" ' Formatação do valor das cavidades como texto
                lastRow.Columns("I").value = cavidadeValue
                lastRow.Columns("J").value = sourceSheet.Range("L19").value
                lastRow.Columns("K").value = problemaBox1.Text
                lastRow.Columns("L").NumberFormat = "@"
                lastRow.Columns("L").value = seq(i)
                lastRow.Columns("M").value = sourceSheet.OLEObjects("tipoamostraBox").Object.value
                lastRow.Columns("N").value = sourceSheet.OLEObjects("turnoBox").Object.value
                lastRow.Columns("O").value = sourceSheet.OLEObjects("comboBoxanalisador").Object.value
                lastRow.Columns("P").NumberFormat = "@"
                lastRow.Columns("P").value = sourceSheet.Range("O12").value
                lastRow.Columns("Q").NumberFormat = "@"
                lastRow.Columns("Q").value = sourceSheet.Range("S19").value
                ' Salva o arquivo de destino
                targetWorkbook.Save
    Next i

    ' Fecha o arquivo de destino sem exibição
    targetWorkbook.Close SaveChanges:=False

    ' Exibe uma mensagem de sucesso ao usuário
    MsgBox "Valores transferidos com sucesso!", vbInformation, "Sucesso"

    ' Fecha a janela do formulário
    Unload Me
End Sub
 
G

goncalo

Member
Local time
Today, 11:30
Joined
May 23, 2023
Messages
51
Code: 
Function Sequence(txtStart As String, num As Long)
    Dim i As Long, nStart As Long, prefix As String, c As String
    Set Sequence = New Collection
    For i = 1 To Len(txtStart)
        c = Mid(txtStart, i, 1)
        If c Like "#" Then Exit For
        prefix = prefix & c ' Extrai todos os valores não númericos da string
    Next i
    nStart = CLng(Mid(txtStart, Len(prefix) + 1)) ' Primeiro valor númerico
    For i = nStart To (nStart + num - 1)
        Sequence.Add prefix & 1 + ((i - 1) Mod 999) '## Cap númerico máximo para 999
    Next i
End Function

Hope this can help someone in the future
 
You must log in or register to reply here.

Similar threads

G
Solved Export data to another workbook
Replies
4
Views
438
goncalo
G
G
How to add an arrow onto a cell?
Replies
1
Views
297
The_Doc_Man
The_Doc_Man
G
Solved Why are my SQL Queries so slow?
Replies
9
Views
947
Minty
Minty
A
Não Consigo Editar os dados da listvew
Replies
4
Views
699
Antonio Augusto Crovador
A
E
VBA Macro Syntax Error While Combining Multiple Worksheets
Replies
2
Views
2,009
Escondido
E

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom