[已解决]急求，用VBA实现，得到结果，谢谢！

yang2739

求大神，在线等，问题没看明白在线问。谢谢！


第一列a右边数值为1的单元格对应的标题是2，  就生成a2=1,
b右边的数值为1的单元格对应的标示是1和4,就生成b1=1,b4=1,以此类推。这样说明白了吗？

最佳答案

月排行榜 / 总排行榜

xdragon

2013-12-19 16:49

1. Sub test111()
   
2. Dim arr, brr(), i As Long, j As Integer, cnt As Long
   
3. arr = Range("A1:M" & Cells(Rows.Count, 1).End(3).Row).Value
   
4. For i = 2 To UBound(arr)
   
5.   For j = 2 To UBound(arr, 2)
   
6.     If arr(i, j) = 1 Then
   
7.       cnt = cnt + 1
   
8.       ReDim Preserve brr(1 To cnt)
   
9.       brr(cnt) = arr(i, 1) & arr(1, j) & "=1"
   
10.     End If
    
11.   Next
    
12. Next
    
13. Range("O2").Resize(cnt) = Application.Transpose(brr)
    
14. End Sub

复制代码

跳转到最佳答案楼层

silenthunter

我是一点也看不明白。问题连一个字都没提。

yang2739

第一列a右边数值为1的单元格对应的标题是2，  就生成a2=1,
b右边的数值为1的单元格对应的标示是1和4,就生成b1=1,b4=1,以此类推。这样说明白了吗？

xdragon

1. Sub test111()
   
2. Dim arr, brr(), i As Long, j As Integer, cnt As Long
   
3. arr = Range("A1:M" & Cells(Rows.Count, 1).End(3).Row).Value
   
4. For i = 2 To UBound(arr)
   
5.   For j = 2 To UBound(arr, 2)
   
6.     If arr(i, j) = 1 Then
   
7.       cnt = cnt + 1
   
8.       ReDim Preserve brr(1 To cnt)
   
9.       brr(cnt) = arr(i, 1) & arr(1, j) & "=1"
   
10.     End If
    
11.   Next
    
12. Next
    
13. Range("O2").Resize(cnt) = Application.Transpose(brr)
    
14. End Sub

复制代码

冥王

几百公里的公式，要不要？