How can i send a value to another file and then increment the same amount of times as i make the code iterate?

huangapple
go评论59阅读模式
英文:

How can i send a value to another file and then increment the same amount of times as i make the code iterate?

问题

基本上，我想要在将该值发送到 dados.xlsm 的列 L 时递增源表格 N19 单元格中的值。假设我在单元格 N19 中写入以下内容："A120"，并选择 4 次重复，我希望在 dados 表的列 L 中看到以下数字："A120"，然后在下面的单元格中依次是："A121"，"A122"，"A123"，"A124"，即希望递增的次数与重复次数相同。

N19 单元格将接收类似于 "C251" 的值类型。另外，如果用户输入类似于 "D999" 并选择 2 次或更多重复，希望将值发送为 "D999"，"D1"，"D2" 等（最大数为 999）。

以下是您尝试的代码，但您不知道如何实现上述功能的部分：

Private Sub CommandButton1_Click()
    ' ... 代码的其余部分 ...

    Dim i As Integer
    For i = 1 To repeticoes
        Select Case True
            ' ----------------------------------------------------------3/4--------------------------------------------------------------
            Case tipoAnaliseBox = "3/4"
                ' ... 处理 "3/4" 类型的情况 ...

            ' ----------------------------------------------------------Fixture--------------------------------------------------------------
            Case tipoAnaliseBox = "Fixture"
                ' ... 处理 "Fixture" 类型的情况 ...

        End Select
    Next i

    ' ... 代码的其余部分 ...
End Sub

您想要实现的功能部分需要在 Case 语句块中添加额外的代码，以根据用户的输入值和重复次数来递增单元格的内容。但是，由于代码较长，我建议您在编写完整的逻辑之前，仔细规划并测试您的解决方案。如果您需要更多帮助或有其他问题，请随时提出。

英文:

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)

I tried the following code but i have no clue on how to implement the function i described earlier

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

If you require a better explanation or more information about my issue feel free to ask and ill do my best to give you a better explanation

Thank you for reading.

答案1

得分: 1

你可以使用一个函数来创建一组序列值。例如：

'返回一个包含`num`个值的集合，每个值都以`txtStart`的非数字前缀开头，带有递增的数字后缀
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 '从字符串开头提取所有非数字字符
Next i
nStart = CLng(Mid(txtStart, Len(prefix) + 1)) '第一个数值
For i = nStart To (nStart + num - 1)
Sequence.Add prefix & 1 + ((i - 1) Mod 999) '##将最大数值部分限制为999
Next i
End Function

在你的代码中（仅相关部分）：

Dim repeticoes As Long, seq As Collection, lastRow As Range
'...
'...
repeticoes = Me.ComboBox1.Value
'生成序列
Set seq = Sequence(sourceSheet.Range("N19").Value, repeticoes) 
'...
'...
For i = 1 To seq.Count
Set lastRow = targetSheet.Cells(targetSheet.Rows.Count, 3).End(xlUp).Offset(1).EntireRow '下一个空行
'...
'...
lastRow.Columns("L").Value = seq(i)
'...
'...
Next i

另外，你可以创建一个子过程来避免重复操作，而不是多次这样做：

targetSheet.Cells(lastRow, "C").NumberFormat = "@"
targetSheet.Cells(lastRow, "C").Value = sourceSheet.OLEObjects("genComboBox").Object.Value

你可以创建一个子过程：

Sub SetTextValue(c As Range, v)
c.NumberFormat = "@"
c.Value = v
End Sub

然后像这样调用它：

SetTextValue targetSheet.Cells(lastRow, "C"), sourceSheet.OLEObjects("genComboBox").Object.Value
英文:

You can use a function to create a set of sequence values. Eg:

'Return a Collection containing `num` values, each beginning with the
'  non-numeric prefix from `txtStart`, with an incrementing numeric suffix
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 'extract all non-numeric characters from the start of the string
Next i
nStart = CLng(Mid(txtStart, Len(prefix) + 1)) 'first numeric value
For i = nStart To (nStart + num - 1)
Sequence.Add prefix & 1 + ((i - 1) Mod 999) '## cap max numeric part to 999
Next i
End Function

In your code (relevant parts only):

    Dim repeticoes As Long, seq As Collection, lastRow As Range
'...
'...
repeticoes = Me.ComboBox1.Value
'generate the sequence
Set seq = Sequence(sourceSheet.Range("N19").Value, repeticoes) 
'...
'...
For i = 1 To seq.Count
Set lastRow = targetSheet.Cells(targetSheet.Rows.Count, 3).End(xlUp).Offset(1).EntireRow 'next empty row
'...
'...
lastRow.Columns("L").Value = seq(i)
'...
'...
Next i

FYI - instead of doing something like this repeatedly:

targetSheet.Cells(lastRow, "C").NumberFormat = "@"
targetSheet.Cells(lastRow, "C").value = sourceSheet.OLEObjects("genComboBox").Object.value

You can make a Sub:

Sub SetTextValue(c As Range, v)
c.NumberFormat = "@"
c.Value = v
End Sub

...and then call it like

SetTextValue targetSheet.Cells(lastRow, "C"), sourceSheet.OLEObjects("genComboBox").Object.value

huangapple
  • 本文由 发表于 2023年7月17日 23:25:01
  • 转载请务必保留本文链接：https://go.coder-hub.com/76705968.html
  • excel
  • increment
  • vba
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定