历遍WORD表格，根据文字内容扣分

ww0000

5.16 巡查.rar (211.61 KB, 下载次数: 23)

2018-6-8 16:40 上传

点击文件名下载附件

历遍WORD表格，根据文字内容扣分
谢谢

qcw911

很牛B的求助

182197315

Sub aa()
Dim i%, sr1$, sr2$, x As Single
With ActiveDocument.Tables(1)
    For i = 2 To .Rows.Count - 1
        sr1 = .Cell(i, 2).Range.Text
        sr2 = .Cell(i, 4).Range.Text
        If sr1 Like "*保洁不到位" Or sr1 Like "零星垃圾" Then
            sr2 = "-0.5分"
        ElseIf sr1 Like "*卫生差" Or sr1 Like "乱搭盖" Or sr1 Like "乱张贴" Or sr1 Like "乱拉挂" Then
            sr2 = "-1分"
        ElseIf sr1 Like "*垃圾堆积" Or sr1 Like "建筑垃圾" Then
            sr2 = "-2分"
        ElseIf sr1 Like "*陈年垃圾" Or sr1 Like "卫生死角" Or sr1 Like "焚烧垃圾" Then
            sr2 = "-3分"
        End If
        x = x + Val(sr2)
    Next
    .Cell(.Rows.Count, 4).Range.Text = 100 + x & "分"
End With
End Sub

妙觉观自在

182197315 发表于 2018-6-8 18:41
Sub aa()
Dim i%, sr1$, sr2$, x As Single
With ActiveDocument.Tables(1)

你的代码忘记给最右列单元格赋值了吧？

妙觉观自在

Sub aa()
Dim i%, sr1$, sr2$, x As Single
With ActiveDocument.Tables(1)
    For i = 2 To .Rows.Count - 1
        sr1 = .Cell(i, 2).Range.Text
        .Cell(i, 2).Select
        
'        sr2 = .Cell(i, 4).Range.Text
        'Like 匹配的关键字前后都要有*号，不然“保洁不到位”后面有字符，就匹配不了
        If sr1 Like "*保洁不到位*" Or sr1 Like "*零星垃圾*" Then
            sr2 = "-0.5分"
            .Cell(i, 4).Range.Text = sr2 '赋值
        ElseIf sr1 Like "*卫生差*" Or sr1 Like "*乱搭盖*" Or sr1 Like "*乱张贴*" Or sr1 Like "*乱拉挂*" Then
            sr2 = "-1分"
            .Cell(i, 4).Range.Text = sr2 '赋值
        ElseIf sr1 Like "*垃圾堆积*" Or sr1 Like "*建筑垃圾*" Then
            sr2 = "-2分"
            .Cell(i, 4).Range.Text = sr2 '赋值
        ElseIf sr1 Like "*陈年垃圾*" Or sr1 Like "*卫生死角*" Or sr1 Like "*焚烧垃圾*" Then
            sr2 = "-3分"
            .Cell(i, 4).Range.Text = sr2 '赋值
        End If
        x = x + Val(sr2) '累积扣分
    Next i
    .Cell(.Rows.Count, 4).Range.Text = 100 + x & "分"
End With
End Sub

182197315

妙觉观自在 发表于 2018-6-8 20:10
你的代码忘记给最右列单元格赋值了吧？

.Cell(.Rows.Count, 4).Range.Text = 100 + x & "分"

妙觉观自在

182197315 发表于 2018-6-8 20:46
.Cell(.Rows.Count, 4).Range.Text = 100 + x & "分"

每遍历到一行的时候，要给当前行的第4列单元格赋予分值啊。
.Cell(i, 4).Range.Text = sr2 '赋值

ww0000

妙觉观自在 发表于 2018-6-8 20:22
Sub aa()
Dim i%, sr1$, sr2$, x As Single
With ActiveDocument.Tables(1)

非常好，谢谢

ww0000

妙觉观自在 发表于 2018-6-8 20:22
Sub aa()
Dim i%, sr1$, sr2$, x As Single
With ActiveDocument.Tables(1)

发现一个问题，代码在单个文件运行时，得分正确，我用代码批量处理同一个文件夹下的多个文件时，得分不正确

jiminyanyan

ww0000 发表于 2018-6-9 16:24
发现一个问题，代码在单个文件运行时，得分正确，我用代码批量处理同一个文件夹下的多个文件时，得分不正 ...

批量运行时，运行另外一个时候，x要先清零的……。