Question

excel vba删除单元格最右内容

代码一
F18：F23范围内删除最后面的0
代码二
1。B18：B23范围（求示出现值）
2。并在内容前加A字母
3。B18求示出现值在E3/B19求示出现值在F3/B20求示出现值在G3/B21求示出现值在H3/B22求示出现值在I3/B23求示出现值在J3
如果第3行有内容了提取到第4行，以此类推

Answer 1

Sub xx()
    Dim c As Range
    For Each c In [f18:f23]
        t = c.Text
        For i = Len(t) To 1 Step -1
            If Right(t, 1) = "0" Then
                t = Left(t, i - 1)
            Else
                Exit For
            End If
        Next
        c = t
    Next
End Sub

追问

代码二
B18：B23范围（求示出现值）

追答

Sub xx()
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To 6
    t = Cells(17 + i, 2)
    For j = 1 To Len(t)
    c = Mid(t, j, 1)
    If Not d.exists(c) Then d.Add c, ""
    Next
    t = "A"
    For j = 0 To 9
    If Not d.exists(CStr(j)) Then t = t & j
    Next
    Cells(3, i + 4) = t
    d.RemoveAll
    Next
End Sub

追问

如果第3行有内容了提取到第4行，以此类推

追答

Sub xx()
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To 6
    t = Cells(17 + i, 2)
    For j = 1 To Len(t)
    c = Mid(t, j, 1)
    If Not d.exists(c) Then d.Add c, ""
    Next
    t = "A"
    For j = 0 To 9
    If Not d.exists(CStr(j)) Then t = t & j
    Next
    j=3
    do while cells(j,i+4)<>""
    j=j+1
    next
    Cells(j, i + 4) = t
    d.RemoveAll
    Next
End Sub

追问

next没有FOR

追答

Sub xx()
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To 6
    t = Cells(17 + i, 2)
    For j = 1 To Len(t)
    c = Mid(t, j, 1)
    If Not d.exists(c) Then d.Add c, ""
    Next
    t = "A"
    For j = 0 To 9
    If Not d.exists(CStr(j)) Then t = t & j
    Next
    j=3
    do while cells(j,i+4)<>""
    j=j+1
    loop
    Cells(j, i + 4) = t
    d.RemoveAll
    Next
End Sub