VBA Excel结合手机二维码扫描获取发票数据

VBA Excel结合手机二维码扫描获取发票数据!对搞财务的同学很有帮助！

Public lv As String

'-------------------------------------------------------------------------------

Sub 发票数据解析()

On Error Resume Next

Dim path As String

'------------------------------------------------------------------------

path = Application.GetOpenFilename

Open path For Input As #1

Arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbLf)

hs = UBound(Arr)

For i = 0 To hs

If Arr(i) Like "*文*本*" Or Arr(i) Like "*扫*描*" Then i = i + 1

Sheets("发票数据").Range("P" & i + 2).Value = Arr(i)

Next i

Close #1

'-------------------------------------------------------------------------

hh = Sheets("发票数据").Range("P1048576").End(xlUp).Row

Sheets("发票数据").Range("P2:P" & hh).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

'--------------------------------------------------------------------------

xhh = Sheets("发票数据").Range("P1048576").End(xlUp).Row - 1

ls = Sheets("发票数据").Range("P1048576").End(xlUp).Row

'--------------------------------------------------------------------------

ReDim Drr(1 To xhh), crr(1 To xhh), frr(1 To xhh), Err(1 To xhh), Hrr(1 To xhh), Srr(1 To xhh)

ReDim krr(1 To xhh), Jrr(1 To xhh)

With Sheets("发票数据")

'---------------------------------------

For J = 1 To xhh

Drr(J) = J

crr(J) = "=sjcf(P" & J + 1 & "," & """" & "," & """" & "," & 2 & ")"

frr(J) = "=sjcf(P" & J + 1 & "," & """" & "," & """" & "," & 3 & ")"

Err(J) = "=sjcf(P" & J + 1 & "," & """" & "," & """" & "," & 4 & ")"

Hrr(J) = "=sjcf(P" & J + 1 & "," & """" & "," & """" & "," & 5 & ")"

Srr(J) = Split(lv, "%")(0)

krr(J) = "=E" & J + 1 & "*F" & J + 1

Jrr(J) = "=E" & J + 1 & "*(1+F" & J + 1 & ")"

Next

.Range("A2:A" & ls).Value = Application.Transpose(Drr)

.Range("B2:B" & ls).Value = Application.Transpose(Hrr)

.Range("C2:C" & ls).Value = Application.Transpose(crr)

.Range("d2:d" & ls).Value = Application.Transpose(frr)

.Range("E2:E" & ls).Value = Application.Transpose(Err)

.Range("F2:F" & ls).Value = Application.Transpose(Srr)

.Range("G2:G" & ls).Value = Application.Transpose(krr)

.Range("H2:H" & ls).Value = Application.Transpose(Jrr)

End With

Call 表格处理

End Sub

Sub 表格处理()

xh = Sheets("发票数据").Range("a1048576").End(xlUp).Row

With Sheets("发票数据")

.Range("a2:e" & xh).Value = .Range("a2:e" & xh).Value

.Range("P:P").ClearContents

.UsedRange.EntireColumn.AutoFit

End With

End Sub

Public Function sjcf(ByVal rng As Range, ByVal str As String, ByVal i As Integer) As String

On Error Resume Next

sjcf = Split(rng, str)(i)

End Function

手机操作步骤：

1、设置批量扫描

2、扫描

3、记录导出TXT

4、电脑模板提取数据