[已解决]提取内容后&

zss7758258

Desktop.zip (95.25 KB, 下载次数: 9)

2015-5-16 10:37 上传

点击文件名下载附件

麻烦老师们了!

最佳答案

月排行榜 / 总排行榜

baksy

2015-5-16 11:07

附件

跳转到最佳答案楼层

baksy

附件

冥王

1. Sub demo()
   
2.     On Error Resume Next
   
3.     Dim myStr1$, myStr2$, iStr$, i%, arr, crr(), drr()
   
4.     With Sheets(1)
   
5.         arr = .Range("E2:H" & .Range("E2").End(xlDown).Row)
   
6. 
   
7.         ReDim crr(1 To 1, 1 To UBound(arr, 1))
   
8.         ReDim drr(1 To 1, 1 To UBound(arr, 1))
   
9.         For i = LBound(arr, 1) To UBound(arr, 1)
   
10.             myStr1 = arr(i, 1)
    
11.             myStr2 = arr(i, 3)
    
12.             iStr = Replace(myStr1, "播放：", "")
    
13.             If Right(iStr, 1) = "万" Then
    
14.                 crr(1, i) = Left(iStr, Len(iStr) - 1) * 10000
    
15.             Else
    
16.                 crr(1, i) = CLng(iStr)
    
17.             End If
    
18.             drr(1, i) = arr(i, 4) & Replace(Mid(myStr2, InStrRev(myStr2, "/") + 1, 999), ".html", "")
    
19.         Next
    
20.         Range("E20").Resize(UBound(arr), 1) = Application.Transpose(crr)  '测试没问题的话修改单元格写入地址，下同
    
21.         Range("I20").Resize(UBound(arr), 1) = Application.Transpose(drr)
    
22.     End With
    
23. End Sub

复制代码

zss7758258

冥王 发表于 2015-5-16 12:05

粘贴您的代码到VBA，为何没有反应啊

zxh1124

冥王 发表于 2015-5-16 12:05

学习了