在Excel中创build条形码

我正在使用条形码字体生成条形码,

column A text - *column B Barcode* 

在ThisWorkbook中,我有以下macros,它可以正常工作。

 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If IsEmpty(Target) Or Target.Column <> 1 And Target.Column <> 4 Then Exit Sub Dim DataRow As Integer DataRow = Target.Cells.Row While Not IsEmpty(Cells(DataRow, Target.Column)) Target.Worksheet.Cells(DataRow, Target.Column + 1) = "*" & Target.Worksheet.Cells(DataRow, Target.Column) & "*" DataRow = DataRow + 1 Wend End Sub 

当我扫描A列中的22位数字时; 在列B上想要跳过前7位数字,并在列B上具有最后15位数字

 eg: If 22 digit skip first 7 If 32 digit skip first 16 & last 4 If 34 digit skip first 22 

在这里输入图像说明

首先, Workbook_SheetChange事件macros的sh参数是包含Target的工作表对象。 你可以直接使用它; 不需要削减Target的工作表。

接下来,在Worksheet_ChangeWorkbook_SheetChange事件macros中添加/修改/删除对象以closuresapplication.enableevents以便macros在其更改/删除/添加值时不会尝试运行相同(或不同)的工作表。

 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Not Intersect(Sh.Range("A:A, D:D"), Target) Is Nothing Then On Error GoTo Fìn Application.EnableEvents = False Dim DataRow As Long, rng As Range For Each rng In Intersect(Sh.Range("A:A, D:D"), Target) Select Case Len(rng.Value2) Case 0 'do nothing Case 22 rng.Offset(0, 1) = Chr(42) & Mid(rng.Value2, 8, 99) & Chr(42) Case 32 rng.Offset(0, 1) = Chr(42) & Mid(rng.Value2, 8, 21) & Chr(42) Case 34 rng.Offset(0, 1) = Chr(42) & Mid(rng.Value2, 23, 99) & Chr(42) Case Else rng.Offset(0, 1) = Chr(42) & rng.Value2 & Chr(42) End Select Next rng End If Fìn: Application.EnableEvents = True End Sub 

Target知道它在哪个工作表上,因此在引用到Target的单元格偏移量时确实不需要定义工作表。

基于Target中值的长度的Select Case … End Select Case最终Select Case似乎是最好的解决scheme,并且易于扩展。

最后,你是否真的需要多个工作表作为Workbook_SheetChange事件macros或单个工作表的Worksheet_Change足够吗?

 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim tmp,v Dim c As Range On Error Goto haveError For Each c in Target.Cells tmp=trim(c.Value) If Len(tmp) > 0 And (c.Column=1 Or c.Column=4) Then Select Case Len(tmp) Case 22: v = Right(tmp, Len(tmp)-7) Case 32: 'etc Case 34: 'etc Case Else: v="" End Select If Len(v)>0 Then Application.EnableEvents = False c.offset(0,1).value = "*" & v & "*" Application.EnableEvents = True End If End If Next c Exit sub haveError: Application.EnableEvents = True End Sub