excel宏如果单元格值不同，新的图标

问题描述

我有下面的代码，它将查看列B，并确定该行是否应该被复制到一个新的单元格，或者如果它应该移动到下一行，根据条件。我想要做的是首先查看A列，员工姓名，如果行k中的名称与第k-1行不一样，则制作新的表格，将行k复制到那里，然后循环周围。最终，每个员工都有自己的表单。

  Sub Sample（）
 
 Dim myarray 
 
 Dim wsInv As Worksheet 
 Dim rngDes As Range，rng As Range，cel As Range 
 Dim k As Long 
 
 Set wsInv = Thisworkbook.Sheets（Inventory ）
设置rng = wsInv.Range（A2，wsInv.Range（A& Rows.Count）.End（xlup）.Address）
设置rngDes = Thisworkbook.Sheets（ （A3）
 
 myarray = Array（CONSUMABLES，FILTERS  -  BILLI TRIO，FILTERS  -  ZIP GENERIC，_ 
GOODS，硬件固定件，照明 -  50W二色，照明 - 紧凑型BC / ES，_ 
照明 - 双色灯，照明 -  FLURO，照明 -  PLC灯840/830 b $ bLIGHTING  -  PL-L，LIGHTING-PULSE STARTER，LIGHTING-STANDARD STARTER，_ 
LIGHTING  -  T5 FLURO，NITROGEN CHARGE，OxyYen / ACETYLENE WELDING 
R-134A，R-22，R-407C，R-410A）
 
k = 0 
对于rng 
如果cel.Value = cel.Offset（-1,0）.V然后
如果不是IsError（Application.Match（cel.Offset（0,1）.value，myarray，0））然后
 cel.EntireRow.Copy rngDes.Offset（k，0）
k = k + 1 
如果
结束If如果
下一个cel $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ b 
如果有人可以至少告诉我可以根据列A值获得新的表格，那将是惊人的，谢谢
解决方案如下所示：尝试这样做：
  Sub Sample（）
 
 Dim myarray 
 
 Dim wsInv As Worksheet，wsDes As Worksheet 
 Dim rngDes As Range，rngEmp As Range，cel As Range 
 
 Set wsInv = ThisWorkbook.Sheets（Inventory ）
设置rngEmp = wsInv.Range（A2，wsInv.Range（A& Rows.Count）.End（xlUp）.Address）
 
 myarray = Array（CONSUMABLES，FILTERS  -  BILLI TRIO，FILTERS  -  ZIP GENERIC，_ 
GOODS ，五金配件，照明 -  50W二色，照明 - 紧凑型BC / ES，_ 
照明 - 双色灯，照明 -  FLURO，照明 -  PLC灯840/830 _ 
LIGHTING  -  PL-L，LIGHTING-PULSE STARTER，LIGHTING  -  STANDARD STARTER，_ 
LIGHTING  -  T5 FLURO，NITROGEN CHARGE，OxyYen / AcetYLENE WELDING ，$ _ 
R-134A，R-22，R-407C，R-410A）
 
对于每个cel在rngEmp 
如果不是IsError （Application.Match（cel.Offset（0，1）.Value，myarray，0））Then 
 On Error Resume Next 
设置wsDes = ThisWorkbook.Sheets（cel.Value）
 On错误GoTo 0 
 
如果wsDes不是，然后设置wsDes = ThisWorkbook.Sheets.Add（之后：= ThisWorkbook.Sheets（ThisWorkbook.Sheets.Count））
 
 wsDes.Name = cel.Value 
 cel（1  - （cel.Row  -  1））。EntireRow.Copy wsDes.R ange（A1）
 cel.EntireRow.Copy wsDes.Range（A& Rows.Count）.End（xlUp）.Offset（1，0）
设置wsDes = Nothing 
结束如果
下一个cel 
 
 End Sub 
  
上面的代码是检查列B 中的值是否为在数组中。
 
如果是，它将会将数据复制到员工后命名的工作表。
 
如果该员工没有现有的工作表，它会创建一个。
 
不知道这是否有帮助，但尝试一下。 
 
I have the below code that will look in column B and determine if the row should be copied to a new cell or if it should move to the next row down, based on the conditions. What I want it to do is to first look in column A, employee names, and if the name in say row k is not the same as in row k-1, then make a new sheet, copy row k to there and then loop around. Eventually, every employee has their own sheet.
Sub Sample()

Dim myarray

Dim wsInv As Worksheet
Dim rngDes As Range, rng As Range, cel As Range
Dim k As Long

Set wsInv = Thisworkbook.Sheets("Inventory")
Set rng = wsInv.Range("A2", wsInv.Range("A" & Rows.Count).End(xlup).Address)
Set rngDes = Thisworkbook.Sheets("Sheet3").Range("A3")

myarray = Array("CONSUMABLES", "FILTERS - BILLI TRIO", "FILTERS - ZIP GENERIC", _
    "GOODS", "HARDWARE FIXINGS", "LIGHTING - 50W DICHROIC", "LIGHTING - COMPACT BC/ES", _
    "LIGHTING - DICHROIC LAMP", "LIGHTING - FLURO", "LIGHTING - PLC LAMP 840/830", _
    "LIGHTING - PL-L", "LIGHTING - PULSE STARTER", "LIGHTING - STANDARD STARTER", _
    "LIGHTING - T5 FLURO", "NITROGEN CHARGE", "OXYGEN / ACETYLENE WELDING", _
    "R-134A", "R-22", "R-407C", "R-410A")

k = 0
For Each cel in rng
    If cel.Value = cel.Offset(-1,0).Value Then
        If Not IsError(Application.Match(cel.Offset(0,1).value, myarray, 0)) Then
            cel.EntireRow.Copy rngDes.Offset(k,0)
            k = k + 1
        End If
    End If
Next cel`
If anyone could at least tell me where I can get to a new sheet based on column A value, that would be amazing, thank you
 解决方案 
As commented, try this:
   Sub Sample()

Dim myarray

Dim wsInv As Worksheet, wsDes As Worksheet
Dim rngDes As Range, rngEmp As Range, cel As Range

Set wsInv = ThisWorkbook.Sheets("Inventory")
Set rngEmp = wsInv.Range("A2", wsInv.Range("A" & Rows.Count).End(xlUp).Address)

myarray = Array("CONSUMABLES", "FILTERS - BILLI TRIO", "FILTERS - ZIP GENERIC", _
    "GOODS", "HARDWARE FIXINGS", "LIGHTING - 50W DICHROIC", "LIGHTING - COMPACT BC/ES", _
    "LIGHTING - DICHROIC LAMP", "LIGHTING - FLURO", "LIGHTING - PLC LAMP 840/830", _
    "LIGHTING - PL-L", "LIGHTING - PULSE STARTER", "LIGHTING - STANDARD STARTER", _
    "LIGHTING - T5 FLURO", "NITROGEN CHARGE", "OXYGEN / ACETYLENE WELDING", _
    "R-134A", "R-22", "R-407C", "R-410A")

For Each cel In rngEmp
    If Not IsError(Application.Match(cel.Offset(0, 1).Value, myarray, 0)) Then
        On Error Resume Next
        Set wsDes = ThisWorkbook.Sheets(cel.Value)
        On Error GoTo 0

        If wsDes Is Nothing Then Set wsDes = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))

        wsDes.Name = cel.Value
        cel(1 - (cel.Row - 1)).EntireRow.Copy wsDes.Range("A1")
        cel.EntireRow.Copy wsDes.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        Set wsDes = Nothing
    End If
Next cel

End Sub
What above code does is check if value in Column B is within the array.
If yes, it will copy data to a Sheet named after the employee.
If that employee don't have an existing Sheet yet, it will create one.
Not sure if this helps, but give it a try. 
                        
这篇关于excel宏如果单元格值不同，新的图标的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！