使用VBA代码在Excel中创建宏 [英] Macro creation in excel using VBA code

问题描述

我想创建一个具有以下要求的宏： -



< pre lang =text> A B C
1234颜色蓝色
1234宽度1.5
1234供应商XYX

输出所需
颜色宽度供应商
1234蓝色1.5XYX

我尝试过：



我想使用VBA代码创建宏。

解决方案

假设工作表＃1包含下面列出的数据，则启动来自A1单元格：



<前lang =text> ID属性值
1234颜色蓝
1234宽度1.5
1234供应商XYX
1235颜色橙色
1235宽度3.5
1235供应商ZZA

并且你希望实现类似的东西（在＃2工作表中）：

  ID颜色宽度供应商 
 1234蓝色1.5XYX 
 1235橙色3.5ZZA 

低于宏观d完成工作：

 选项 明确 
 
  Sub  RowsToColumns（）
  Dim  i 作为 整数，j  As  整数，k 作为 整数 
  Dim  srcWsh 作为工作表，dstWsh  As 工作表
 
 开启 错误  GoTo  Err_RowsToColumns 
 
 ' 您需要更改代码上下文！ 
 ' 读取bel ow comments  
 设置 srcWsh = ThisWorkbook.Worksheets（ 1 ） 是指工作簿中的第一个工作表 - 源工作表 
 设置 dstWsh = ThisWorkbook.Worksheets（ 2 ）' 指工作簿中的第二个工作表 - 目标工作表 
 dstWsh.Cells.Delete xlShiftUp ' 先清理！ 
 使用 dstWsh.Range（  A1）
 .Value =   ID 
 .Font.Bold =  True  
 .Interior.Color = vbGreen 
 结束 使用 
 
i =  2  
j =  2  
     srcWsh .Range（  A& i）<>   
 ' < span class =code-comment> ID  
 dstWsh.Range（  A& j）= srcWsh.Range（  A& i）
 ' 其他属性 
k =  0  
     srcWsh.Range（  & i + k）= srcWsh.Range（  A& i）
 使用 dstWsh.Range（   B1）。偏移量（ColumnOffset：= k）
 .Value = srcWsh.Range（  B& i + k）
 .Font.Bold =  True  
 .Interior.Color = vbGreen 
 结束 使用 
 dstWsh.Range（  B& j）.Offset（ColumnOffset：= k）= srcWsh.Range（  C& i + k）
k = GetColumnNo（srcWsh.Range（  B& i + k），dstWsh）
 循环 
i = i + k 
j = j +  1  
 循环 
 
 Exit_RowsToColumns：
  On  错误 恢复 下一步 
 设置 srcWsh = 无 
 设置 dstWsh =  Nothing  
 退出  Sub  
 
 Err_RowsToColumns：
 MsgBox Err.Description，vbExclamation，Err.Number 
  Resume  Exit_RowsToColumns 
 
 
 结束  Sub  
 
 功能 GetColumnNo（sHeader  As   String ，wsh  As 工作表）作为 整数 
 昏暗 c 作为 整数 
 
c =  0  
 执行   wsh.Range（  A1）。偏移量（ColumnOffset：= c）<>   
 如果 wsh .Range（  A1）。偏移量（ColumnOffset：= c）= sHeader 然后 退出   
c = c +  1  
 循环 
 
 GetColumnNo = c 
 
 结束 功能 

注意：数据和上面的宏应该在同一个工作簿中。

使用宏记录功能。

- 开始录制

- 执行您想要的操作

- 停止录制。

您现在可以根据需要编辑和修改宏。

Hi,

I want to create a macro with the below requirement:-

A	B	C
1234	Color	 Blue
1234	Width	 1.5"
1234	Supplier XYX

output required
A        Colour  Width   Supplier
1234     Blue    1.5"     XYX

What I have tried:

I want to create a macro using VBA code.

解决方案

Assuming that a worksheet #1 contains the data listed below, started from A1 cell:

ID	Property	Value
1234	Color	Blue
1234	Width	1.5"
1234	Supplier	XYX
1235	Color	Orange
1235	Width	3.5"
1235	Supplier	ZZA

and you want to achieve something like that (in a #2 worksheet):

ID	Color	Width	Supplier
1234	Blue	1.5"	XYX
1235	Orange	3.5"	ZZA

below macro should do the job:

Option Explicit

Sub RowsToColumns()
    Dim i As Integer, j As Integer, k As Integer
    Dim srcWsh As Worksheet, dstWsh As Worksheet
    
    On Error GoTo Err_RowsToColumns

    'you need to change a code-context!
    'read below comments
    Set srcWsh = ThisWorkbook.Worksheets(1) 'refers to first worksheet in a workbook - source worksheet
    Set dstWsh = ThisWorkbook.Worksheets(2) 'refers to second worksheet in a workbook - destination worksheet
    dstWsh.Cells.Delete xlShiftUp 'clean up first!
    With dstWsh.Range("A1")
        .Value = "ID"
        .Font.Bold = True
        .Interior.Color = vbGreen
    End With
    
    i = 2
    j = 2
    Do While srcWsh.Range("A" & i) <> ""
        'ID
        dstWsh.Range("A" & j) = srcWsh.Range("A" & i)
        'other properties
        k = 0
        Do While srcWsh.Range("A" & i + k) = srcWsh.Range("A" & i)
            With dstWsh.Range("B1").Offset(ColumnOffset:=k)
                .Value = srcWsh.Range("B" & i + k)
                .Font.Bold = True
                .Interior.Color = vbGreen
            End With
            dstWsh.Range("B" & j).Offset(ColumnOffset:=k) = srcWsh.Range("C" & i + k)
            k = GetColumnNo(srcWsh.Range("B" & i + k), dstWsh)
        Loop
        i = i + k
        j = j + 1
    Loop
    
Exit_RowsToColumns:
    On Error Resume Next
    Set srcWsh = Nothing
    Set dstWsh = Nothing
    Exit Sub

Err_RowsToColumns:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_RowsToColumns


End Sub

Function GetColumnNo(sHeader As String, wsh As Worksheet) As Integer
    Dim c As Integer
    
    c = 0
    Do While wsh.Range("A1").Offset(ColumnOffset:=c) <> ""
        If wsh.Range("A1").Offset(ColumnOffset:=c) = sHeader Then Exit Do
        c = c + 1
    Loop
    
    GetColumnNo = c

End Function

Note: the data and above macro should be in the same workbook.

Use the Macro Record feature.
- Start recording
- Perform the actions you want
- Stop recording.
You can now edit and modify the macro as required.

这篇关于使用VBA代码在Excel中创建宏的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！