Генерация количества данных «(x, y)» в ячейке со ссылкой на число

Question

(например: 1 = (x1, y1), 3 = (x1, y1, x2, y2, x3, y3)

Как удалить ненужные "(,)", как показано ниже, и поставить номер положения координат x, y надежности с ошибкой со ссылкой на число под заголовком надежности с ошибками? Например: количество ошибок надежности = 2 в устройстве WLR8 ~ LW ~ VBD ~ MNW должно дать мне позицию этого Ошибка считается в той же строке, что и устройство в столбце X. В любом случае, пожалуйста, игнорируйте данные под столбцами V и W на моих рисунках.

Токовый вывод на основе моего кода

Что я действительно хочу

Текущий выпуск

Текущий выпуск2 где это должно быть

Dim output As Variant
Dim outputrow As Integer
output = ""
outputrow = 0
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Sheets(1)

Dim ia As Long
Dim lastrow2 As Long
lastrow2 = ws1.Range("U2:U" & ws1.Rows.Count).Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row

If ws1.Range("U1") = "Reliability Fail" Then
 For ia = 2 To lastrow2
    If ws1.Cells(ia, "U").Value = 0 Then
    output = output & "(" & ws1.Cells(ia, "Y").Value & "," & ws1.Cells(ia, "Z").Value & "),"
    ElseIf output = "(,)," Then 'if there are no x and y values in Y and Z column stop showing "(,),"
    output = ""
    End If
    If ws1.Cells(ia, "U").Value > 0 Then
    ws1.Cells(ia, "U").Offset(0, 3).Value = Left(output, Len(output) - 1) 'extract the x and y values obtain in (x,y) format
                    'if there is "value" under reliability fails(column U), put the x y position at the same row as the "value" at column X
    End If
    Next
End If

Answer 1

Я предлагаю использовать внутренний l oop, чтобы дополнительные скобки не добавлялись в первую очередь

Option Explicit

Sub test()


Dim output As Variant
Dim outputrow As Integer
Dim valueCount As Long, ib As Long
output = ""
outputrow = 0
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Sheets(1)

Dim ia As Long
Dim lastrow2 As Long
lastrow2 = ws1.Range("U2:U" & ws1.Rows.Count).Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row

If ws1.Range("U1") = "Reliability Fail" Then

' Outer loop over all rows
 For ia = 2 To lastrow2
  valueCount = ws1.Cells(ia, "U").Value
  output = ""

  ' Inner loop to process repeated rows
  For ib = 1 To valueCount
    output = output & "(" & ws1.Cells(ia + ib - 1, "Y").Value & "," & ws1.Cells(ia + ib - 1, "Z").Value & ")"
    If ib < valueCount Then output = output & ","
   Next ib
   ws1.Cells(ia, "U").Offset(0, 3).Value = output
 Next ia
End If

End Sub

РЕДАКТИРОВАТЬ

Вот исправленный код в свете более позднего примера ОП:

Option Explicit

Sub test()

Dim output As Variant
Dim outputrow As Integer
Dim valueCount As Long, ib As Long, rowPointer As Long
output = ""
outputrow = 0
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Sheets(1)

Dim ia As Long
Dim lastrow2 As Long
lastrow2 = ws1.Range("U2:U" & ws1.Rows.Count).Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row

If ws1.Range("U1") = "Reliability Fail" Then

rowPointer = 2
' Outer loop over all rows
 For ia = 2 To lastrow2
  valueCount = ws1.Cells(ia, "U").Value
  output = ""

  ' Inner loop to process repeated rows
  For ib = 1 To valueCount
    output = output & "(" & ws1.Cells(rowPointer, "Y").Value & "," & ws1.Cells(rowPointer, "Z").Value & ")"
    If ib < valueCount Then output = output & ","
    rowPointer = rowPointer + 1
  Next ib
  ws1.Cells(ia, "U").Offset(0, 3).Value = output
 Next ia
End If

End Sub

Answer 2

Во-первых, удалите лишние пустые пары, используя это:

output = Replace(Range("X" & lRow), ",(,)", "")

Затем вы должны иметь только те пары, которые вам нужны.

Затем разделите его на ), и добавьте ), если он не заканчивается на единицу. Вот пример, который вы можете использовать, чтобы включить его в свой код:

Sub test()
  Dim lRow As Long
  Dim vSplit As Variant
  Dim sResult As String
  Dim output as String

  For lRow = 2 To 3

    If Len(Range("X" & lRow)) > 0 And Val(0 & Range("U" & lRow)) > 0 Then

      output = Replace(Range("X" & lRow), ",(,)", "")  ' this strips out the extra empty pairs

      vSplit = Split(output, "),") ' this creates a string array, 1 item for each pair

      sResult = vSplit(Val(Range("U" & lRow)) - 1) ' this gets the one you want based on column U ( -1 because the Split array is 0 based)

      If Right$(sResult, 1) <> ")" Then sResult = sResult & ")" ' this adds a ")" if one is missing

      Debug.Print sResult ' debug code

      Range("X" & lRow) = sResult ' this adds the result to column X, replacing what was there

   End If

  Next

End Sub