我想把图一 单元格内数据 以"/"自动向下分列换行 达到图二效果。

jiaxinl

llh521 发表于 2017-8-16 14:32
数据默认前面有俩空格   自动点 宏的话 前面 俩空格需要  手动去除  这个 能帮我 修改下吗 ？  谢谢

Option Explicit
Sub test()
Dim m&, n&, k&
Dim arr, brr, crr()
arr = Range([h3], Range("j" & Range("h1048576").End(xlUp).Row))
For m = LBound(arr, 1) To UBound(arr, 1)
brr = Split(arr(m, 3), " / ")
For n = LBound(brr) To UBound(brr)
k = k + 1
ReDim Preserve crr(1 To 3, 1 To k)
crr(1, k) = arr(m, 1)
crr(2, k) = arr(m, 2)
If n = 0 Then
   crr(3, k) = Replace(brr(n), " ", "")
Else
  crr(3, k) = brr(n)
End If
Next
Range("A3").Resize(k, 3) = WorksheetFunction.Transpose(crr) Next
End Sub

llh521

jiaxinl 发表于 2017-8-16 15:03
Option Explicit
Sub test()
Dim m&, n&, k&

修改了以后 前面俩空格是 没了 可是  每个单元个第一个数据里的 空格也跟着被取消了。  我给你 发图。黄色标记了。

jiaxinl

llh521 发表于 2017-8-16 15:24
修改了以后 前面俩空格是 没了 可是  每个单元个第一个数据里的 空格也跟着被取消了。  我给你 发图。黄 ...

If n = 0 Then
   crr(3, k) = Replace(brr(n), " ", "")
Else
  crr(3, k) = brr(n)
End If

改为

If n = 0 Then
   crr(3, k) = Replace(brr(n), Left(brr(n),2), "")
Else
  crr(3, k) = brr(n)
End If

llh521

jiaxinl 发表于 2017-8-16 16:34
If n = 0 Then
   crr(3, k) = Replace(brr(n), " ", "")
Else

非常非常感谢      再次表示感谢

paciguard

数量不多，可以用转置：
Sub 按钮1_Click()
Dim a, b(), c(), u&, v&
a = Range("H3:J" & [j65536].End(3).Row)
v = 1: u = 0
For i = 1 To UBound(a)
u = u + UBound(Split(a(i, 3), "/")) + 1
ReDim Preserve b(1 To u): ReDim Preserve c(1 To u)
  For j = 0 To UBound(Split(a(i, 3), "/"))
  b(v) = a(i, 1)
  c(v) = Split(a(i, 3), "/")(j)
  v = v + 1
  Next j
Next i
[a25].Resize(UBound(b)) = Application.Transpose(b)
[c25].Resize(UBound(c)) = Application.Transpose(c)
End Sub

02761752696

谢谢    分享

新纪元

cbtaja 发表于 2017-8-16 14:04
对代码按符号"/"分列，然后用数据透视表得到结果。

你好，请问是怎么做到的（步骤）谢谢！

cbtaja

llh521 发表于 2017-8-16 17:14
非常非常感谢      再次表示感谢

用Ltrim函数最简单，它仅剪除字符串的左端开始的连续空格。

处理空格的VB函数还有：
Rtrim：剪除字符串的右端开始的连续空格、
Trim：不仅包含Ltrim、Rtrim的作用，而且把字符串中间的连续空格修剪为1个空格

llh521

jiaxinl 发表于 2017-8-16 16:34
If n = 0 Then
   crr(3, k) = Replace(brr(n), " ", "")
Else

你好 大神，我想把您给我写的代码，在进阶修改下。是否能帮修改下呢。

jiaxinl

llh521 发表于 2018-6-19 11:39
你好 大神，我想把您给我写的代码，在进阶修改下。是否能帮修改下呢。

具体是要怎么修改呢？有新附件吗