填充给定起点和终点的字母数字值范围

Question

有一个 table 三列和 ~9,400 行列出了字母数字代码范围的开始和结束值以及分配给这些范围的第三个值。希望将两列范围端点更改为一列明确列出的 (1:1) 值。您能想出一种方法来自动明确列出范围内的值吗？

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

期望的输出：
|--代码-|ccs|
| 0106吨 | 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函数有错误。语句错误，下标超出范围错误。不确定预期结果是否是 sheet 数字。 R3uK，你能澄清一下吗？谢谢。

Answer 3

仅供参考，这是一些示例数据和使用的最终宏。我不是程序员，已经达到了 "good enough" 的地步。非常感谢 R3uK 带路：

r1 | r2 |抄送
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

填充给定起点和终点的字母数字值范围

Populate range of alpha-numeric values given start and end points

mysql

excel

vba

range

data-manipulation