尝试从大括号中提取数据但不工作 [英] Trying to extract data from curly braces but not working
问题描述
我需要将C列中的大括号{}中的值进行同步，并将它们与列F中的用户标识相对照，如下所示。
例如。在电子邮件表单上
在新的表格上成为这个。
Sub CopyConditional（）
Dim wshS As工作表
Dim WhichName As String
设置wshS = ActiveWorkbook.Sheets（电子邮件）
WhereName =NewSheet
Const NameCol =C
Const FirstRow = 1
Dim LastRow As Long
Dim SrcRow As Long
Dim TrgRow As Long
Dim wshT As Worksheet
Dim cpt As String
Dim user As String
Dim computers（）As String
Dim computer As String
On Error Resume Next
设置wshT = Worksheets whereName）
如果wshT不是，然后
设置wshT = Worksheets.Add（之后：= wshS）
wshT.Name = WhereName
结束如果
错误GoTo 0
如果wshT.Cells（1，NameCol）.value =然后
TrgRo w = 1
Else
TrgRow = wshT.Cells（wshT.Rows.Count，NameCol）.End（xlUp）.Row + 1
End If
LastRow = wshS.Cells（wshS.Rows.Count，NameCol）.End（xlUp）.Row
对于SrcRow = FirstRow To LastRow
cpt = wshS.Range（C& SrcRow）.value
user = wshS.Range（F& SrcRow）.value
如果InStr（cpt，：）然后
cpt = Mid（cpt ，InStr（1，cpt，：）+ 1，Len（cpt））
End If
如果InStr（cpt，;）然后
computers = （cpt，;）
对于i = 0到UBound（计算机）
如果计算机（i）<> 然后
wshT.Range（A& TrgRow）.value = user
wshT.Range（B& TrgRow）.value = Mid（Left（computers（i），Len （电脑（i）） - 1），2）
TrgRow = TrgRow + 1
结束如果
下一个
Else
电脑= cpt
如果电脑<> 然后
wshT.Range（A& TrgRow）.value = user
wshT.Range（B& TrgRow）.value = Mid（Left（computer，Len（computer） - 1），2）
TrgRow = TrgRow + 1
如果
结束If
下一个SrcRow
End Sub
我使用上述代码解决了这个问题，但有三个棘手的问题： / p>
1）第一个大括号总是被复制，我如何省略这样的东西，像 {Computer1 code>计算机1
2）连接中有两台电脑，输出如下所示：
当它应该被分成两个不同的行，例如
用户1 |电脑1
用户1 |计算机2
3）如果在最后一个大括号之后有文本，其中包含文本。 {Computer1}; {Computer2};请求提交然后那个文本被添加为一个新行，我不想这样，我想要省略，例如
应该是：
用户1 |电脑1
用户1 |计算机2
我如何解决这些问题？
尝试这样：
Sub Collapse（）
作为范围，cel As Range
Dim comps As Variant，comp As Variant，r As Variant，v As Variant
Dim d As Dictionary'~~>早期绑定，对于晚期绑定使用注释行
'Dim d As Object
Dim a As String
With Sheet1'~~>包含您的数据的工作表
设置uRng = .Range（F1，.Range（F& .Rows.Count）.End（xlUp））
结束
设置d = CreateObject（Scripting.Dictionary）
对于每个cel在uRng
a =替换（cel.Offset（0，-3），{，
comps = Split（a，}）
Debug.Print UBound（comps）
对于每个comp在comps
如果InStr（comp，Computer） <> 0 _
And Len（Trim（comp））< = 10 Then'~~>我假设max Comp＃是99
如果不是.Exists（cel）然后
.Add cel，comp
Else
如果IsArray（.Item（cel））然后
r = .Item（cel）
ReDim Preserve r（UBound（r）+ 1）
r（UBound（r））= comp
.Item（cel）= r
Else
r = Array（.Item（cel），comp）
.Item（cel）= r
End If
End If
End If
Next
下一个
结束
对于每个v在d.Keys
与Sheet2'~~>如果IsArray（d.Item（v））然后
.Range（A& .Rows.Count）.End（xlUp）.Offset（1， 0）_
.Resize（UBound（d.Item（v））+ 1）= v
.Range（B& .Rows.Count）.End（xlUp）.Offset（1 ，0）_
.Resize（UBound（d.Item（v））+ 1）= Application.Transpose（d.Item（v））
Else
.Range（A & .Rows.Count）.End（xlUp）.Offset（1，0）= v
.Range（B& .Rows.Count）.End（xlUp）.Offset（1,0） = d.Item（v）
End If
End With
Next
设置d =无
End Sub
以上代码使用替换和拆分功能将您的字符串传递给数组。
a =替换（cel.Offset（0，-3），{，}）'~~>标准化分隔符
comps = Split（a，}）'~~>使用标准分隔符分割
然后，使用用户键作为项目将信息传递到字典对象。 br>
我们使用 Instr和Len函数过滤传递到字典的项目
如果InStr（comp，Computer）<> 0 _
And Len（修剪（comp））< = 10然后
我已经评论过，我假设你的最大电脑数是99.
否则你需要检查的任何长度改变10。
最后我们将字典信息返回到目标工作表。 br>
注意：如果您喜欢早期绑定，则需要添加对Microsoft Scripting Runtime的引用
结果：我尝试了一个小样本数据，我如何看到它在SS中。
所以假设你在Sheet1中有这个数据：
输出数据在Sheet2中，如下所示：
I need to sync up the values in the curly braces {} found in column C and put them against the user id in column F as seen below.
E.g. on the Emails sheet
becomes this on a new sheet
Sub CopyConditional()
Dim wshS As Worksheet
Dim WhichName As String
Set wshS = ActiveWorkbook.Sheets("Emails")
WhichName = "NewSheet"
Const NameCol = "C"
Const FirstRow = 1
Dim LastRow As Long
Dim SrcRow As Long
Dim TrgRow As Long
Dim wshT As Worksheet
Dim cpt As String
Dim user As String
Dim computers() As String
Dim computer As String
On Error Resume Next
Set wshT = Worksheets(WhichName)
If wshT Is Nothing Then
Set wshT = Worksheets.Add(After:=wshS)
wshT.Name = WhichName
End If
On Error GoTo 0
If wshT.Cells(1, NameCol).value = "" Then
TrgRow = 1
Else
TrgRow = wshT.Cells(wshT.Rows.Count, NameCol).End(xlUp).Row + 1
End If
LastRow = wshS.Cells(wshS.Rows.Count, NameCol).End(xlUp).Row
For SrcRow = FirstRow To LastRow
cpt = wshS.Range("C" & SrcRow).value
user = wshS.Range("F" & SrcRow).value
If InStr(cpt, ":") Then
cpt = Mid(cpt, InStr(1, cpt, ":") + 1, Len(cpt))
End If
If InStr(cpt, ";") Then
computers = Split(cpt, ";")
For i = 0 To UBound(computers)
If computers(i) <> "" Then
wshT.Range("A" & TrgRow).value = user
wshT.Range("B" & TrgRow).value = Mid(Left(computers(i), Len(computers(i)) - 1), 2)
TrgRow = TrgRow + 1
End If
Next
Else
computer = cpt
If computer <> "" Then
wshT.Range("A" & TrgRow).value = user
wshT.Range("B" & TrgRow).value = Mid(Left(computer, Len(computer) - 1), 2)
TrgRow = TrgRow + 1
End If
End If
Next SrcRow
End Sub
I managed to resolve it with the above code but there are 3 niggling issues:
1) The first curly brace is always copied, how do I omit this so something like {Computer1 looks like Computer 1
2) Where there are two computers in a row, then the output looks something like this:
when it should really be split into two different rows i.e.
User 1 | Computer 1
User 1 | Computer 2
3) If there is text after the last curly brace with text in it e.g. {Computer1};{Computer2};Request submitted then that text is added as a new row, I don't want this, I want it to be omitted e.g.
should just be:
User 1 | Computer 1
User 1 | Computer 2
How do I go about rectifying these issues?
Try this:
Sub Collapse()
Dim uRng As Range, cel As Range
Dim comps As Variant, comp As Variant, r As Variant, v As Variant
Dim d As Dictionary '~~> Early bind, for Late bind use commented line
'Dim d As Object
Dim a As String
With Sheet1 '~~> Sheet that contains your data
Set uRng = .Range("F1", .Range("F" & .Rows.Count).End(xlUp))
End With
Set d = CreateObject("Scripting.Dictionary")
With d
For Each cel In uRng
a = Replace(cel.Offset(0, -3), "{", "}")
comps = Split(a, "}")
Debug.Print UBound(comps)
For Each comp In comps
If InStr(comp, "Computer") <> 0 _
And Len(Trim(comp)) <= 10 Then '~~> I assumed max Comp# is 99
If Not .Exists(cel) Then
.Add cel, comp
Else
If IsArray(.Item(cel)) Then
r = .Item(cel)
ReDim Preserve r(UBound(r) + 1)
r(UBound(r)) = comp
.Item(cel) = r
Else
r = Array(.Item(cel), comp)
.Item(cel) = r
End If
End If
End If
Next
Next
End With
For Each v In d.Keys
With Sheet2 '~~> sheet you want to write your data to
If IsArray(d.Item(v)) Then
.Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) _
.Resize(UBound(d.Item(v)) + 1) = v
.Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) _
.Resize(UBound(d.Item(v)) + 1) = Application.Transpose(d.Item(v))
Else
.Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) = v
.Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) = d.Item(v)
End If
End With
Next
Set d = Nothing
End Sub
Above code uses Replace and Split Function to pass your string to array.
a = Replace(cel.Offset(0, -3), "{", "}") '~~> standardize delimiter
comps = Split(a, "}") '~~> split using standard delimiter
Then information are passed to dictionary object using User as key and computers as items.
We filter the items passed to dictionary using Instr and Len Function
If InStr(comp, "Computer") <> 0 _
And Len(Trim(comp)) <= 10 Then
As I've commented, I assumed your max computer number is 99.
Else change 10 to whatever length you need to check.
Finally we return the dictionary information to the target worksheet.
Note: You need to add reference to Microsoft Scripting Runtime if you prefer early bind
Result: I tried it on a small sample data patterned on how I see it in you SS.
So assuming you have this data in Sheet1:
Will output data in Sheet2 like this:
这篇关于尝试从大括号中提取数据但不工作的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
