大神来帮帮忙，看看附件，有2个需求

skytutu1

气愤excel 发表于 2018-4-25 19:43
第一个问题的代码，第二个问题很难解决

大神，第一个有点问题，我是要把任意区域2个单元格内的内容合并到前一个的单元格内，即2222单元格内容到1111单元格内。麻烦帮忙修改下，谢谢

skytutu1

第一个可能是我没说太清楚，附件内的excel,C6与C7单元格的内容合并到B6与B7里，只是内容过去，不是合并单元格，希望大神给我个能自己选局域的。

skytutu1

大神们来帮帮忙

气愤excel

skytutu1 发表于 2018-4-26 00:10
大神，第一个有点问题，我是要把任意区域2个单元格内的内容合并到前一个的单元格内，即2222单元格内容到1 ...

1. Public Sub CharConnection()
   
2. Dim arr, i%
   
3. arr = Range("b6").CurrentRegion
   
4. For i = 1 To UBound(arr)
   
5.     For j = 2 To UBound(arr, 2)
   
6.         If arr(i, j) <> "" Then
   
7.             arr(i, 1) = CStr(arr(i, 1)) & CStr(arr(i, j))
   
8.         End If
   
9.     Next
   
10. Next
    
11. [b:b].ClearContents
    
12. [b6].Resize(UBound(arr), 1) = arr
    
13. End Sub

复制代码

代码没有问题，只是将G列换成B列就行了

skytutu1

气愤excel 发表于 2018-4-26 10:10
代码没有问题，只是将G列换成B列就行了

好的谢谢大神，么么么么么么么哒，第二个问题我自己手动录入。看来太复杂了。

skytutu1

气愤excel 发表于 2018-4-26 10:10
代码没有问题，只是将G列换成B列就行了

大神，我今天用的时候，为什么他提示我运行时错误13，If arr(i, j) <> "" Then这段代码变黄了。。。
，不是错误值的原因，还是类型不匹配。

lsdongjh

没有什么难度，关键是你描述的太空，给个真实数据的附件，并实际描述一下要求的效果

skytutu1

lsdongjh 发表于 2018-4-27 12:01
没有什么难度，关键是你描述的太空，给个真实数据的附件，并实际描述一下要求的效果

帖子里就有的，是有位大神帮我解决了问题的，但是今天用代码的时候就出错了，If arr(i, j) <> "" Then这行代码出错了。

lsdongjh

1. Option Explicit
   
2. '问题1
   
3. Sub Test1()
   
4.     Dim Rg As Range, lngRow As Long
   
5.     Dim arr As Variant
   
6.     On Error Resume Next
   
7.     Set Rg = Application.InputBox("请选择需要合并内容的单元格", Type:=8)
   
8.     If Rg Is Nothing Then Err.Clear: Exit Sub
   
9.    
   
10.     If Rg.Column <> 2 Then Exit Sub
    
11.    
    
12.     arr = Rg
    
13.    
    
14.     For lngRow = LBound(arr) To UBound(arr)
    
15.         arr(lngRow, 1) = arr(lngRow, 1) & arr(lngRow, 2)
    
16.         arr(lngRow, 2) = ""
    
17.     Next
    
18.    
    
19.     Rg = arr
    
20. End Sub
    
21. 
    
22. '问题2
    
23. Sub Test()
    
24.     Dim SH As Worksheet, Rg As Range
    
25.     Dim strTemp As String
    
26.     Dim lngLen As Long
    
27.     Dim lngIndex As Long, lngColorIndex As Long
    
28.     Dim strColor As String
    
29.    
    
30.     Set SH = Sheet1
    
31.     Set Rg = SH.Range("B18")
    
32.     strTemp = Rg.Value
    
33.    
    
34.     lngLen = Len(strTemp)
    
35.    
    
36.     For lngIndex = 1 To lngLen
    
37.         lngColorIndex = Rg.Characters(lngIndex, 1).Font.ColorIndex
    
38.         If lngColorIndex <> 1 And lngColorIndex <> -4105 Then
    
39.             strColor = strColor & Mid(strTemp, lngIndex, 1)
    
40.         End If
    
41.     Next
    
42.    
    
43.     MsgBox "有颜色的字符为：【" & strColor & "】"
    
44.    
    
45.     strTemp = Replace(strTemp, strColor, "[前面加了东东]" & strColor & "【前面加了东东】")
    
46.    
    
47.     Rg.Value = strTemp
    
48. End Sub
    

复制代码

气愤excel

skytutu1 发表于 2018-4-27 12:12
帖子里就有的，是有位大神帮我解决了问题的，但是今天用代码的时候就出错了，If arr(i, j)  "" Then这行 ...

If arr(i, j) <> "" 是判断除最左侧单元格外单元格是否为空，为空则不连接，连接的不只两个，多个都行，也可以有空格，我运行时没有错误，请上传附件，然后才能原因