如何将EXCEL中题库转换成需要的格式显示

lion3583

如附件所示，怎么用vb将EXCEL中左边的格式转换成右边的格式。求高手解决

zhsiyu9600

请上附件，谢谢

lion3583

附件，谢谢

imleading

如果全是选择题，应该比较容易。题号后面都有一个.或者abc后面都是.那还比较容易判断，判断符合就写入就好了。

准提部林

Sub TEST_A1()
Dim Arr, Brr(1 To 20000, 1 To 8), T$, i&, k%, R&, C%
Sheet2.UsedRange.Offset(1, 0).EntireRow.Delete
Arr = Range(Sheet1.[a1], Sheet1.Cells(Rows.Count, 1).End(3))
For i = 1 To UBound(Arr)
    T = Arr(i, 1)
    If Val(T) > 0 Then
       k = InStrRev(T, "("): R = R + 1: C = 1
       Brr(R, 1) = Left(T, k - 1)
       Brr(R, 8) = Replace(Mid(T, k + 1), ")", "")
    Else
       C = C + 1: Brr(R, C) = T
    End If
i01: Next i
Sheet2.[A2].Resize(R, 8) = Brr
End Sub

Xl0000093.rar (10.44 KB, 下载次数: 5)

2020-11-16 13:05 上传

点击文件名下载附件

zpy2

lion3583 发表于 2020-11-16 11:05
附件，谢谢

附件解析结果。。 解析结果.xlsx.zip (5.94 KB, 下载次数: 2)

2020-11-16 13:32 上传

点击文件名下载附件

machunze

粘帖运行了事，也不上传附件了

1. Sub 题库格式整理()
   
2. With Sheets("单选题")
   
3.         .Rows("1:1").Select
   
4.         Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
   
5.         .Range("A1").FormulaR1C1 = "单选题"
   
6.         .Range("C1").FormulaR1C1 = "题目"
   
7.         .Range("D1").FormulaR1C1 = "A"
   
8.         .Range("E1").FormulaR1C1 = "B"
   
9.         .Range("F1").FormulaR1C1 = "C"
   
10.         .Range("G1").FormulaR1C1 = "D"
    
11.         .Range("H1").FormulaR1C1 = "E"
    
12.         .Range("I1").FormulaR1C1 = "答案"
    
13.         Dim n As Integer, r As Integer, arr(), str As String
    
14.         .Range("C2:I" & .[i65536].End(xlUp).Row + 1).ClearContents
    
15.         For n = 2 To .[a65536].End(xlUp).Row
    
16.                 If Left(.Cells(n, "A").Text, 1) Like "#" Then
    
17.                         r = 0
    
18.                         Do
    
19.                                 ReDim Preserve arr(0 To r)
    
20.                                 arr(r) = .Cells(n + r, "A").Value
    
21.                                 r = r + 1
    
22.                         Loop Until Left(.Cells(n + r, "A").Text, 1) Like "#" Or .Cells(n + r, "A") = ""
    
23.                         str = Left(Right(arr(0), 2), 1)
    
24.                         arr(0) = Replace(arr(0), Right(arr(0), 3), "")
    
25.                         .Cells(.[c65536].End(xlUp).Row + 1, "C").Resize(1, UBound(arr) + 1) = arr
    
26.                         .Cells(.[i65536].End(xlUp).Row + 1, "I").Value = str
    
27.                 End If
    
28.         Next
    
29. End With
    
30. End Sub
    

复制代码

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   With Worksheets("单选题")
   
5.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
6.     arr = .Range("a1:a" & r)
   
7.   End With
   
8.   ReDim brr(1 To UBound(arr), 1 To 10)
   
9.   m = 0
   
10.   For i = 1 To UBound(arr)
    
11.     If Left(arr(i, 1), 1) Like "#" Then
    
12.       m = m + 1
    
13.       n = 1
    
14.       brr(m, 1) = arr(i, 1)
    
15.     Else
    
16.       n = n + 1
    
17.       brr(m, n) = Split(arr(i, 1), ".")(1)
    
18.     End If
    
19.   Next
    
20.   With Worksheets("sheet1")
    
21.     .Range("a2").Resize(m, UBound(brr, 2)) = brr
    
22.   End With
    
23. End Sub
    

复制代码

chxw68

简单问题。