求助，高手请帮忙

新人2018

单位需要把一个试题卷在EXECL转成一道题一行 达到模版题形的效果，由于没有太多规律，本人技术不行，请哪位高手帮忙给看看，先谢过了

新人2018

有哪位高手能帮帮忙吗

痛痛痛痛

没有规律，自求多福吧！先手动操作吧

传说中的胖子

占座，占座学习

linchuang0413

=INDEX(试题!A:A,SMALL(IF(ISNUMBER(--LEFT(试题!新建_文本文档,1))=TRUE,ROW(试题!新建_文本文档),62533),ROW(A1)))模板D2单元格，数组

新人2018

能用组合方法变成有规律的，然后再做成想要的格式吗，我的思路是，把所有单选、多选都变成一行，然后把答案选项ABCDEF分成列，最后把（）里面的答案提取出来，这样就成模版上规定的格式了，哪个高手帮忙实现下

新人2018

痛痛痛痛 发表于 2019-4-14 22:54
没有规律，自求多福吧！先手动操作吧

你好，能否先把单选、多选变成一行，就是一行中是  题目和答案选项 ，然后把风答案选项分列分成A B C D 各一列，最后用FIND函数把答案提取出来，这样就能形成模版想要的样式了，能实现吗

新人2018

linchuang0413 发表于 2019-4-14 23:13
=INDEX(试题!A:A,SMALL(IF(ISNUMBER(--LEFT(试题!新建_文本文档,1))=TRUE,ROW(试题!新建_文本文档),62533), ...

能否把做好的带公式的附件表上传下，不胜感激！！谢谢了！

linchuang0413

具体可以看附件，应该比这有更好的公式，其它可以使用数据分列，比这个要快

tz2302200

1. Sub test()
   
2. Dim rg As Range, r As Integer
   
3. 
   
4. arr = Array("A", "B", "C", "D", "E", "对", "错")
   
5. r = 2
   
6. t = 0
   
7. start = 0
   
8. For i = 1 To 154
   
9.     If InStr(1, Sheets(1).Range("a" & i), ".") > 0 And _
   
10.     InStr(1, Sheets(1).Range("a" & i), "A.") = False And _
    
11.     InStr(1, Sheets(1).Range("a" & i), "B.") = False And _
    
12.     InStr(1, Sheets(1).Range("a" & i), "C.") = False And _
    
13.     InStr(1, Sheets(1).Range("a" & i), "D.") = False And _
    
14.     InStr(1, Sheets(1).Range("a" & i), "E.") = False And _
    
15.     InStr(1, Sheets(1).Range("a" & i), "F.") = False Then
    
16.         Sheets(2).Range("d" & r) = Sheets(1).Range("a" & i)   '找题目
    
17.         
    
18.         ss = Sheets(2).Range("d" & r)
    
19.         
    
20.         If InStr(1, ss, "（") > 0 Then
    
21.             ks = InStr(1, ss, "（")
    
22.             Else
    
23.             ks = 1
    
24.         End If
    
25.         
    
26.         For Each a In arr
    
27.             If InStr(ks, ss, a) > 0 Then
    
28.                 If start = 0 Then start = InStr(ks, ss, a)
    
29.                 t = t + 1
    
30.             End If
    
31.         Next a
    
32.         
    
33.         On Error Resume Next
    
34.         Sheets(2).Range("e" & r) = Mid(ss, start, t)      '找abcde
    
35.         On Error GoTo 0
    
36.         t = 0
    
37.         start = 0
    
38.         
    
39.         
    
40. 
    
41.         
    
42.         r = r + 1
    
43.     End If
    
44. 
    
45. 
    
46. 
    
47. 
    
48. Next i
    
49. End Sub

复制代码

写了半天只能转换题目和ABCDE ，后面太麻烦我也不会弄了