给定起始点和结束点的字母数字值的范围

Question

有一个包含三列和〜9,400行的表格，列出了代码的字母数字范围的开始和结束值以及指定给范围的第三个值。希望将两列范围端点更改为明确列出（1：1）值的单列。你能想到一种方法来自动化范围内的明确列表值？

当前示例行：
| --- r1 ---- | --- r2 ---- | ccs |
| 0106T | 0110T | 7 |

所需输出：
| --code- | ccs |
| 0106T | 7 |
| 0107T | 7 |
| 0108T | 7 |
| 0109T | 7 |
| 0110T | 7 |

这是存储在一个MySQL数据库和Excel工作簿，但任何语言或庄园的操作都很好。

Answer 1

如果只能用一个“T”，这将工作，是一个很好的基础，以完整的宏：

Sub Alpha() 
Dim WsS As Worksheet 
Set WsS = Worksheets("Source") 
Dim WsR As Worksheet 
Set WsR = DeleteAndAddSheet("Results") 

For i = 2 To WsS.Range("A" & Rows.Count).End(xlUp).Row 

    For k = Val(WsS.Cells(i, 1)) To Val(WsS.Cells(i, 2)) 
     WsR.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = k & "T " & WsS.Cells(i, 3) 
    Next k 

Next i 

End Sub 

有用的功能表：

Public Function DeleteAndAddSheet(ByVal SheetName As String) As Worksheet 

For Each aShe In Sheets 
    If aShe.Name <> SheetName Then 
    Else 
     Application.DisplayAlerts = False 
     aShe.Delete 
     Application.DisplayAlerts = True 
     Exit For 
    End If 
Next aShe 

Sheets.Add after:=Sheets(Sheets.Count) 
Sheets(Sheets.Count).Name = SheetName 

Set DeleteAndAddSheet = ThisWorkbook.Worksheets(Worksheets.Count) 

End Function 

Answer 2

综观提供的解决方案通过R3uK，Set DeleteAndAddSheet语句中的DeleteAndAddSheet函数看起来有错误。下标超出范围错误的语句错误。不确定预期的结果是否为图纸编号。你可以澄清一下吗？ 谢谢。

Answer 3

仅供参考这是一些示例数据和最终使用的宏。我不是程序员，已经达到了“足够好”的地步。非常感谢R3uK领先的方式：

r1 | r2 | ccs
0001T | 0002T | 52
0003T | 0003T | 130
0005T | 0006T | 59
0007T | 0007T | 211
0008T | 0008T | 93
0009T | 0009T | 125
00100 | 00104 | 232
0010T | 0010T | 40
00120 | 00126 | 232
0012T | 0013T | 162
00140 | 00148 | 232
0014T | 0014T | 176
17999 | 17999 | 175
19000 | 19001 | 165
19020 | 19020 | 175
19030 | 19103 | 165
C2018 | C2018 | 243
C2019 | C2019 | 243
C2020 | C2020 | 243
C2021 | C2021 | 243
C2022 | C2022 | 243
C2023 | C2023 | 243

Public Function DeleteAndAddSheet(ByVal SheetName As String) As Worksheet 

For Each aShe In Sheets 
    If aShe.Name <> SheetName Then 
    Else 
     Application.DisplayAlerts = False 
     aShe.Delete 
     Application.DisplayAlerts = True 
     Exit For 
    End If 
Next aShe 

Sheets.Add after:=Sheets(Sheets.Count) 
Sheets(Sheets.Count).Name = SheetName 

Set DeleteAndAddSheet = ThisWorkbook.Worksheets(Worksheets.Count) 

End Function 

Sub Popluate_Ranges() 

Dim WsS As Worksheet 
Set WsS = Worksheets("Sheet1") 
Dim WsR As Worksheet 
Set WsR = DeleteAndAddSheet("Results") 
Dim sc As Integer 
Dim sr As Integer 
Dim rc As Integer 
Dim rr As Long 
Dim rr2 As Long 
Dim rc2 As Integer 
Dim a As String 
Dim b As String 
Dim c As String 
Dim v1 As String 
Dim v2 As String 
Dim d As String 
Dim e As String 
Dim f As String 
Dim i As Integer 

'break string into 3 parts for handling 

rr = 1 
rc = 1 
sr = 2 
sc = 1 

For sr = 2 To WsS.Range("A2").End(xlDown).Row 

    For sc = 1 To 2 
    'write the first digit to first result column 
    WsR.Cells(rr, rc) = Left(Format(WsS.Cells(sr, sc), "00000"), 1) 
    rc = rc + 1 
    'write the middle 3 digits to the second result column 
    WsR.Cells(rr, rc) = Right(Left(Format(WsS.Cells(sr, sc), "00000"), 4), 3) 
    rc = rc + 1 
    'write the last digit to the third result column 
    WsR.Cells(rr, rc) = Right(Format(WsS.Cells(sr, sc), "00000"), 1) 
    rc = rc + 1 
    Next sc 

    'write ccs 
    WsR.Cells(rr, rc) = WsS.Cells(sr, sc) 
    rr = rr + 1 
    rc = 1 

Next sr 
WsR.Range("B:B").NumberFormat = "000" 
WsR.Range("E:E").NumberFormat = "000" 

rr = 1 
rc = 1 
rr2 = 1 
rc2 = 8 

For rr = 1 To WsR.Range("A1").End(xlDown).Row 
     'write/rejoin range start value 

     a = WsR.Cells(rr, rc).Value 
     b = WsR.Cells(rr, rc + 1).Value 
     c = WsR.Cells(rr, rc + 2).Value 
     WsR.Cells(rr2, rc2) = Format(a, "0") & Format(b, "000") & Format(c, "0") 
     WsR.Cells(rr2, rc2 + 1) = WsR.Cells(rr, 7).Value 
     rr2 = rr2 + 1 

     'check if at the end of the range 
     d = WsR.Cells(rr, rc + 3).Value 
     e = WsR.Cells(rr, rc + 4).Value 
     f = WsR.Cells(rr, rc + 5).Value 


     Do Until (a = d And b = e And c = f) 

       If IsNumeric(a) = False Then 
        i = a 
        i = i + 1 
        v1 = a 
        c = Right(i, 1) 
        v2 = a 
        If v1 = 9 And v2 = 0 Then 
         b = b + 1 
        End If 

       ElseIf IsNumeric(c) = False Then 

        b = b + 1 

       Else: 
       i = c 
        i = i + 1 
        v1 = c 
        c = Right(i, 1) 
        v2 = c 
        If v1 = 9 And v2 = 0 Then 
         b = b + 1 
        End If 

       End If 

       WsR.Cells(rr2, rc2) = Format(a, "0") & Format(b, "000") & Format(c, "0") 
       WsR.Cells(rr2, rc2 + 1) = WsR.Cells(rr, 7).Value 
       'WsR.Cells(rr2, rc2 + 2) = rr 
       rr2 = rr2 + 1 

     Loop 

Next rr 
WsR.Range("H:H").NumberFormat = "00000" 
WsR.Activate 
Range("A1:G1").EntireColumn.Delete 
End Sub